Hidden Symmetry of the Kepler Problem

This notebook illustrate the effect of the hidden symmetry groups on the planar Kepler orbits of fixed energy h.

Negative Energy Case

For the negative energy case,  the hidden symmetry group is SO(3).  For mass m=1 and energy h = -1/2, the Kepler orbits are all of the ellipses with semimajor axis 1.  By a coordinate change, these are transformed into the great circles on the unit sphere in R^3.  Rotating the sphere produces a transformation of the ellipses.

The position and velocity variables on the sphere will be Q=(Q0,Q1,Q2), P=(P0,P1,P2).  Then the corresponding position in the plane is given by the following function.

q[{Q0_,Q1_,Q2_},{P0_,P1_,P2_}]:=P0*{Q1,Q2}-(Q0-1)*{P1,P2}

The circular orbit of the Kepler problem is the transform of the following simple great circle geodesic.  All the other orbits will be obtained by rotating this great circle and then transforming.

Qcirc[u_] :={0,Cos[u],Sin[u]}
Pcirc[u_]:= {0,-Sin[u],Cos[u]}

ParametricPlot[q[Qcirc[u],Pcirc[u]],{u,0,2*Pi}]

One way to specify a rotation matrix in Mathematica is with an axis and a rotation angle around the axis.  To specify the axis, we will use spherical coordinates with North pole (1,0,0)

axis[theta_,phi_]:={Cos[theta]*Cos[phi],Sin[theta]*Cos[phi],Sin[phi]}
rotmatrix[theta_,phi_,angle_]:=RotationMatrix[angle, axis[theta,phi]]

Apply the rotation to the great circle and transform it to get the new elliptical orbit.

TransCircle[Q_,P_,theta_,phi_,angle_,u_]:=With[{R=rotmatrix[theta,phi,angle]},R.Q[u]]
TransOrb[Q_,P_,theta_,phi_,angle_,u_]:=With[{R=rotmatrix[theta,phi,angle]},q[R.Q[u],R.P[u]]]

ct=Table[TransCircle[Qcirc,Pcirc,Pi/2.,0,angle,u],{angle,0,2*Pi,Pi/10}];
et=Table[TransOrb[Qcirc,Pcirc,Pi/2.,0,angle,u],{angle,0,2*Pi,Pi/10}];
cp=ParametricPlot3D[ct,{u,0,2*Pi},Axes->False]
ep=ParametricPlot[et,{u,0,2*Pi}]
Show[GraphicsGrid[{{cp,ep}}]]

MakeOrbitPlot[theta_,phi_,angle_]:=
ParametricPlot[TransOrb[Qcirc,Pcirc,theta,phi,angle,u],{u,0,2*Pi},PlotStyle->{ Blue},PlotRange->{{-2,2},{-2,2}}]

MakeSpherePlot[theta_,phi_,angle_]:=Module[{R},
sph = {Opacity[0.2],Sphere[{0,0,0}],Opacity[1]};
pole = {Red,PointSize[0.05],Point[{1,0,0}]};
ax = {Black,Thick,Arrow[{{0,0,0},1.3*axis[theta,phi]}]};
geo=ParametricPlot3D[TransCircle[Qcirc,Pcirc,theta,phi,angle,u],{u,0,2*Pi},PlotStyle->{Thick,Blue},SphericalRegion->True];
Show[Graphics3D[sph~Join~pole~Join~ax],geo,ViewPoint->{0,-3,0},SphericalRegion->True]]

MakeDoublePlot[theta_,phi_,angle_]:=Show[GraphicsGrid[{{MakeSpherePlot[theta,phi,angle],MakeOrbitPlot[theta,phi,angle]}}]]

MakeSpherePlot[0,Pi/2,1.3]
MakeOrbitPlot[0,Pi/2,1.3]
MakeDoublePlot[0,Pi/2,1.3]

Manipulate[MakeDoublePlot[theta,phi,angle],{theta,0,2*Pi},{{phi,0},-Pi/2,Pi/2},{angle,0,2*Pi}]

Zero Energy Case

For h=0, the Kepler orbits are parabolas in the plane.  By a coordinate change, these are transformed into the geodesics of the 
Euclidean metric in R^2, that is, the straight lines.  The hidden symmetry group is Euc(2).  Rotating and translating the lines produces a transformation of the parabolas.

The position and velocity variables of the geodesics will be Q=(Q1,Q2), P=(P1,P2).  Then the corresponding position on the parabola in the plane is given by the following function.

q[{Q1_,Q2_},{P1_,P2_}]:=(2*(Q1*P1+Q2*P2){Q1,Q2}-(Q1^2+Q2^2){P1,P2})/2

A simple geodesic in the plane moving along the vertical line Q1 = 1

Qvert[u_] :={ 1,u}
Pvert[u_]:= { 0,1}

Here is the corresponding parabolic orbit.

q[Qvert[u],Pvert[u]]
ParametricPlot[q[Qvert[u],Pvert[u]],{u,-2,2}]

A translation in the plane is specified by a vector {t1,t2} and a rotation by an angle theta.  Apply these to the vertical geodesic and transform it to get the new parabolic orbits.

rotmatrix2D[theta_]:= {{Cos[theta],-Sin[theta]},{Sin[theta],Cos[theta]}}
TransLine[Q_,P_,t1_,t2_,theta_,u_]:=rotmatrix2D[theta].(Q[u]+{t1,t2})
TransParab[Q_,P_,t1_,t2_,theta_, u_]:=q[rotmatrix2D[theta].(Q[u]+{t1,t2}),P[u]]

Here is a one parameter family of lines and the corresponding parabolas.

ct=Table[TransLine[Qvert,Pvert,t1,t1,0,u],{t1,-2,2,0.2}];
et=Table[TransParab[Qvert,Pvert,t1,t1,0,u],{t1,-2,2,0.2}];
cp=ParametricPlot[ct,{u,-10,10},Axes->False,PlotRange->{{-5,5},{-5,5}}]
ep=ParametricPlot[et,{u,-5,5},PlotRange->{{-5,5},{-5,5}}]
Show[GraphicsGrid[{{cp,ep}}]]

MakeOrbitPlot0[t1_,t2_,theta_]:=
ParametricPlot[TransParab[Qvert,Pvert,t1,t2,theta,u],{u,-3,3},PlotStyle->{ Blue},PlotRange->{{-2,2},{-2,2}}]

MakeLinePlot[t1_,t2_,theta_]:=
ParametricPlot[TransLine[Qvert,Pvert,t1,t2,theta,u],{u,-3,3},PlotStyle->{ Blue},PlotRange->{{-2,2},{-2,2}}]

MakeDoublePlot0[t1_,t2_,theta_]:=Show[GraphicsGrid[{{MakeLinePlot[t1,t2,theta],MakeOrbitPlot0[t1,t2,theta]}}]]

Manipulate[MakeDoublePlot0[t1,t2,theta],{{t1,0},-1,1},{{t2,0},-1,1},{theta,0,2*Pi}]