Mathematica中的球坐标图形

Question

在Mathematica中是否可以创建类似于这样的球坐标系图形，还是应该使用Photoshop？我问这个问题是因为我想要高分辨率的图形，但是互联网上的许多文件在缩放时都会出现颗粒状。

这是图片：

- J. B. DeShaw

---

你好，欢迎来到StackOverflow。您能具体说明一下您想要实现什么吗？ - Mr.Wizard

@Mr. Wizard：你的编辑速度太快了！我看到帖子时显示36秒前，还没等我加上图片，你就已经完成了！ - user616736

Answer 1

这个图形由简单的几何形状组成，可以使用数学软件Mathematica中的方程式轻松地重新创建。下面是一个与此图相似的方程式，我认为它比上面那个更简洁，但您始终可以使用这些想法来完全重新创建您的图像。

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[Darker@Green, 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}}
 ]

这将给你这个：

虽然可以精确设置角度和箭头，但在某些地方（例如13 Pi/20），我只是粗略地近似了它。在最终的图形中，您真的看不出差别，但如果您很挑剔，可以更改它们并精确修复位置。

- user616736

---

我完全忽略了这种可能的解读。我一直在试图弄清楚他想要制作什么样的球坐标图形，比如那些360度照片或环境贴图。 - Mr.Wizard

Answer 2

这种替代方案的优点是使用了3D指令来创建。因此，很容易将其包装在Manipulate中，并且您可以使用鼠标拖动它以改变视角：

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]}]

- gdelfino

---

当phi ==零时存在问题。 - Dr. belisarius

我想在接受答案之前尝试一下你的代码...你能让它在旧版本上工作吗？ - J. B. DeShaw

你遇到了什么错误？我刚在Mathematica 7.0.1版本下成功地测试了它。顺便说一句，我已经将初始phi值更改为0.01，以避免belisarius报告的问题。 - gdelfino