Gráficos de coordenadas esféricas en Mathematica

¿Es posible crear gráficos de un sistema de coordenadas esféricas como este en mathematica o debería usar Photoshop? Lo estoy preguntando porque quiero un gráfico de alta resolución, pero muchos de los archivos en Internet son granulosos cuando se amplía.Gráficos de coordenadas esféricas en Mathematica

Aquí está la imagen:

enter image description here

Fuente

2011-04-25 J. B. DeShaw

Hola y bienvenidos a StackOverflow. ¿Podría ser un poco más específico sobre lo que desea lograr? –

@Mr. Wizard: ¡Estás locamente rápido en la edición! ¡Pensé que vi la publicación cuando decía 36 segundos atrás, y antes de que pudiera agregarla, lo has hecho! – abcd

@yoda es magia. ;-) –

La figura se compone de formas geométricas simples y estos pueden ser recreados fácilmente en Mathematica usando ecuaciones. Aquí hay uno que está cerca del diagrama this, que IMO está menos desordenado que el anterior, pero siempre puede usar estas ideas para recrear su imagen exactamente.

Clear[ellipsePhi, ellipseTheta, circle] 
circle[x_] = {Cos[x], Sin[x]}; 
ellipsePhi[x_, a_: - Pi/2] = {Cos[x - a]/3, Sin[x + a]}; 
ellipseTheta[x_, a_: 0] = {Cos[x + a], Sin[-x - a]/2}; 
(*Main circle*) 
ParametricPlot[circle[x], {x, 0, 2 Pi}, 
PlotStyle -> Black, 
Epilog -> First /@ { 
    (*Ellipses*) 

    ParametricPlot[{ellipsePhi[x], ellipsePhi[-x], ellipseTheta[-x], 
     ellipseTheta[x]}, {x, 0, Pi}, 
    PlotStyle -> {{Black, Dashed}, Black}], 
    (*Co-ordinate axes*) 

    Graphics[ 
    Table[GeometricTransformation[{Arrowheads[0.03], 
     Arrow[{{0, 0}, {1.2, 0}}]}, 
     ReflectionMatrix[circle[x]]], {x, {Pi/2, -Pi/4, Pi/8}}]], 
(*mark point, rho, phi & theta directions*) 

ParametricPlot[{ellipsePhi[x, Pi/2], ellipseTheta[-x, 13 Pi/20]}, {x, 
    0, Pi/4}, 
    PlotStyle -> {{Red, Thick}, {Blue, Thick}}] /. 
Line[x__] :> Sequence[Arrowheads[0.03], Arrow[x]], 
Graphics[{{Directive[[email protected], Thick], Arrowheads[0.03], 
    Arrow[{{0, 0}, ellipsePhi[-3 Pi/4]}]}, 
    {Directive[Purple], Disk[ellipsePhi[-3 Pi/4], 0.02]}}], 
(*text*) 
Graphics[{ 
    Text[Style["x", Italic, Larger], 1.25 circle[5 Pi/4]], 
    Text[Style["y", Italic, Larger], 1.25 circle[0]], 
    Text[Style["z", Italic, Larger], 1.25 circle[Pi/2]], 
    Text[Style["\[Rho]", Italic, Larger], 0.4 circle[4 Pi/11]], 
    Text[Style["\[CurlyPhi]", Italic, Larger], 
    1.1 ellipsePhi[Pi + Pi/5]], 
    Text[Style["\[Theta]", Italic, Larger], 
    1.1 ellipseTheta[13 Pi/20 - Pi/8]], 
    Text[Style["P", Italic, Larger], 1.2 ellipsePhi[-3 Pi/4 + Pi/24]]}] 
}, 
Axes -> False, PlotRange -> 1.3 {{-1, 1}, {-1, 1}} 
]

que le da este

enter image description here

Aunque es posible ajustar los ángulos & flechas, precisamente, en algunos lugares (por ejemplo, 13 pi/20), he aproximar sólo aproximadamente eso. Realmente no puedes ver la diferencia en la figura final, pero si eres exigente puedes cambiarlos y arreglar las posiciones exactamente.

Fuente

2011-04-25 00:14:18 abcd

Me perdí por completo esta posible lectura. Estaba tratando de averiguar qué tipo de gráficos de coordenadas esféricas, como esas fotos de 360 °, o mapas de entorno, estaba tratando de hacer. –

guau, eso se ve bien! –

Esta solución alternativa tiene la ventaja de ser creada usando directivas 3D. Como tal, era fácil para envolver el interior de un manipular y lo puede arrastrar con el ratón para cambiar el punto de vista:

Manipulate[ 
Module[{x = Sin[\[Phi]] Cos[\[Theta]], y = Sin[\[Phi]] Sin[\[Theta]], 
    z = Cos[\[Phi]]}, 
    Show[ 
    ParametricPlot3D[ 
    {{Cos[t], Sin[t], 0}, 
    {0, Sin[t], Cos[t]}, 
    {Sin[t], 0, Cos[t]}}, 
    {t, 0, 2 \[Pi]}, PlotStyle -> Black, Boxed -> False, 
    Axes -> False, AxesLabel -> {"x", "y", "z"}], 
    ParametricPlot3D[0.5*{Cos[t], Sin[t], 0}, {t, 0, \[Theta]}], 
    ParametricPlot3D[ 
    RotationTransform[\[Theta], {0, 0, 1}][{Sin[t]/2, 0, 
     Cos[t]/2}], {t, 0, \[Phi]}], 
    Graphics3D[{ 
    {{Blue, Thick, 
     Arrow[{{0, 0, 0}, #}] & /@ {{1, 0, 0}, {0, 1, 0}, {0, 0, 
      1}, {x, y, z}}}, 
     {Opacity[0.1], 
     Red, Polygon[{{0, 0, 0}, {x, y, 0}, {x, y, z}}], 
     Green, Polygon[{{0, 0, 0}, {x, 0, 0}, {x, y, 0}}]}}, 
    {Opacity[0.05], Sphere[{0, 0, 0}]}, 
    {Text["O", {-.03, -.03, -.03}], 
     Text["X", {1.1, 0, 0}], 
     Text["Q", {x, y, 0}, {1, 1}], 
     Text["P", {x, y, z}, {0, -1}], 
     Text["Y", {0, 1.1, 0}], 
     Text["Z", {0, 0, 1.1}], 
     Text["r", {x/2, y/2, 0}, {1, 1}], 
     Text[ 
     "\[Theta]", {Cos[\[Theta]/2]/2, Sin[\[Theta]/2]/2, 0}, {1, 
     1}], 
     Text["\[Phi]", 
     RotationTransform[\[Theta], {0, 0, 1}][{Sin[\[Phi]/2]/2, 0, 
     Cos[\[Phi]/2]/2}], {1, 1}]}}]]], 
{{\[Phi], \[Pi]/4}, 0.01, \[Pi]/2}, {{\[Theta], \[Pi]/4}, 0.01, 
    2 \[Pi]}]

spherical coordinates

Fuente

2011-04-25 02:23:04 gdelfino

Existe un problema cuando phi == zero –

código no funciona en ver 7 :( –

me gustaría probar su código antes de aceptar una respuesta ... ¿podría hacerlo funcionar en la versión anterior? –

Gráficos de coordenadas esféricas en Mathematica

Respuesta

Cuestiones relacionadas