Exploring Spherical Coordinates

CreateLabel[x_,y_]:=Sequence[Replace[x,{True->Sequence[],False->Sequence[0," ≤ "]}],y,Replace[x,{True-> " = ",False->" ≤ "}]]

CreateLabel[{radius_,angle1_,angle2_},{a_,b_,c_},d_]:=Text@TraditionalForm@Style[Row[{CreateLabel[a,r],radius,", ",CreateLabel[b,θ],angle1,", ",CreateLabel[c,ϕ],angle2,"  ",d}],14]

SphericalCoordinatePlots[l1:{radius_,angle1_,angle2_},l2:{False,False,False},opts___]:=Identity[{CreateLabel[l1,l2,"(solid)"],Show[ParametricPlot3D[{radius Sin[s] Cos[t],radius Sin[s] Sin[t],radius Cos[s]},{t,-0.01,angle1},{s,-0.01,angle2},opts],ParametricPlot3D[{rad Sin[angle2] Cos[t],rad Sin[angle2] Sin[t],rad Cos[angle2]},{t,-0.01,angle1},{rad,-0.01,radius},opts],ParametricPlot3D[{{rad Sin[s] Cos[angle1],rad Sin[s] Sin[angle1],rad Cos[s]},{rad Sin[s],0,rad Cos[s]}},{s,-0.01,angle2},{rad,-0.01,radius},opts]]}]

SphericalCoordinatePlots[l1:{radius_,angle1_,angle2_},l2:{True,True,True},opts___]:=Identity[{CreateLabel[l1,l2,"(point)"],Graphics3D[{AbsolutePointSize[7],Point[{radius Sin[angle2] Cos[angle1],radius Sin[angle2] Sin[angle1],radius Cos[angle2]}]},PlotRange->1,SphericalRegion->True,Axes->True]}]

SphericalCoordinatePlots[l1:{radius_,angle1_,angle2_},l2:{True,False,False},opts___]:=Identity[{CreateLabel[l1,l2,"(surface)"],ParametricPlot3D[{radius Sin[s] Cos[t],radius Sin[s] Sin[t],radius Cos[s]},{s,-0.01,angle2},{t,-0.01,angle1},opts]}]

SphericalCoordinatePlots[l1:{radius_,angle1_,angle2_},l2:{False,False,True},opts___]:=Identity[{CreateLabel[l1,l2,"(surface)"],ParametricPlot3D[{rad Sin[angle2] Cos[t],rad Sin[angle2] Sin[t],rad Cos[angle2]},{rad,-0.01,radius},{t,-0.01,angle1},opts]}]

SphericalCoordinatePlots[l1:{radius_,angle1_,angle2_},l2:{False,True,False},opts___]:=Identity[{CreateLabel[l1,l2,"(surface)"],ParametricPlot3D[{rad Sin[s] Cos[angle1],rad Sin[s] Sin[angle1],rad Cos[s]},{rad,-0.01,radius},{s,-0.01,angle2},opts]}]

SphericalCoordinatePlots[l1:{radius_,angle1_,angle2_},l2:{True,True,False},opts___]:=Identity[{CreateLabel[l1,l2,"(curve)"],ParametricPlot3D[{radius Sin[s] Cos[angle1],radius Sin[s] Sin[angle1],radius Cos[s]},{s,-0.01,angle2},opts]}]

SphericalCoordinatePlots[l1:{radius_,angle1_,angle2_},l2:{True,False,True},opts___]:=Identity[{CreateLabel[l1,l2,"(curve)"],ParametricPlot3D[{radius Sin[angle2] Cos[t],radius Sin[angle2] Sin[t],radius Cos[angle2]},{t,-0.01,angle1},opts]}]

SphericalCoordinatePlots[l1:{radius_,angle1_,angle2_},l2:{False,True,True},opts___]:=Identity[{CreateLabel[l1,l2,"(curve)"],ParametricPlot3D[{rad Sin[angle2] Cos[angle1],rad Sin[angle2] Sin[angle1],rad Cos[angle2]},{rad,-0.01,radius},opts]}]

Manipulate[Column[SphericalCoordinatePlots[{ρ,t,s},{fixr,fixt,fixs},PlotRange->1,ImageSize->350,PerformanceGoal->"Speed",SphericalRegion->True],ItemSize->{{Automatic},{3}},Alignment->{Center,Center}],{{ρ,1,"r"},0,1,ImageSize->Tiny},{{t,7π/4,"θ"},0,2π,ImageSize->Tiny},{{s,π/4,"ϕ"},0,π,ImageSize->Tiny},{{fixr,False,"single r"},{False,True}},{{fixt,False,"single θ"},{False,True}},{{fixs,False,"single ϕ"},{False,True}},ControlPlacement->Left,SaveDefinitions->True]

THIS NOTEBOOK IS THE SOURCE CODE FROM

"Exploring Spherical Coordinates" from The Wolfram Demonstrations Project
 http://demonstrations.wolfram.com/ExploringSphericalCoordinates/

Contributed by: Faisal Mohamed

A full-function Wolfram Mathematica 6 system is required to edit this notebook.
GET WOLFRAM MATHEMATICA 6 »

© The Wolfram Demonstrations Project & Contributors   |   Terms of Use   |   Make a new version of this Demonstration »