Veff de Kepler

Vio=RGBColor[0.75,0.,0.82];

Elijo μ=5 y k=1 y E=-50

m=5;k=1;r0=4;

Veff[l_,r_]:=((l^2)/(2m (r^2)))-(k/r)
rc[l_]:=((l^2)/(m k));Ec[l_]:=-((m (k^2))/(2(l^2)));rmin[l_,En_]:=-(k/(2 En))(1-(Sqrt[1+((2En (l^2))/(m (k^2)))]));rmax[l_,En_]:=-(k/(2 En))(1+(Sqrt[1+((2En (l^2))/(m (k^2)))]));
rper[l_,en_]:=(1/(2*en))(1-(Sqrt[1-2*en*((l^2)/5)]))
raf[l_,en_]:=(1/(2*en))(1+(Sqrt[1-2*en*((l^2)/5)]))
Ecc[l_,en_]:=(Sqrt[1-((2*en*(l^2))/5)])

Elijo algún valor de ℓ y de (Subscript[E, elipse])

ll=2.5;El=-.2;N[Ec[ll]]

Veff3=Plot[{.1,0,El,Ec[ll],Veff[ll,r]},{r,.55,8},
AxesOrigin->{0,0},AxesLabel->{r,(Subscript[V, eff])},Ticks->{{{rc[ll],"(Subscript[r, c])"},{rmin[ll,El],"(Subscript[r, min])"},{rmax[ll,El],"(Subscript[r, max])"}}},PlotStyle->{{ColorData[97,2],Dashed,Thick},{ColorData[97,3],Dashed,Thick},{ColorData[97,4],Dashed,Thick},{ColorData[97,5],Dashed,Thick},{ColorData[97,1],Thick}},PlotLegends->LineLegend[{"E>0","E=0","E<0","E=(Subscript[E, c])"},LegendFunction->(Framed[#,RoundingRadius->5]&),LegendMargins->5]];
p3=Graphics[{PointSize-> Large,{Vio,Point[{rc[ll],Ec[ll]}]},{Black,Point[{rmin[ll,El],El}]},{Black,Point[{rmax[ll,El],El}]}}];
PVeff3=Show[Veff3,p3]

Export["fig1Ej3.png",PVeff3]

Ecuación órbita para α=4/3

A=0.2;ecc=0.7;rper=A(1-ecc);raf=A(1+ecc);

r[α_,ϕ_]:=((A(1-(ecc^2)))/(1+ecc Cos[α*ϕ]))

Grafico la trayectoria en un ciclo, ϕ=2π/α

fig6a=Show[PolarPlot[{rper,raf},{ϕ,0,2π},PlotLegends->{"(Subscript[r, per])","(Subscript[r, af])"},PlotStyle->Dashed,Ticks->None],PolarPlot[r[4/3,ϕ],{ϕ,0,2π*3/4},PlotStyle->Black,Ticks->None],AxesLabel->{x,y},Epilog->Text[Style["ϕ=2π(3/4)=((3  π)/2)",{Gray,13}],Offset[{0,0},Scaled[{1,.3}]],{.9,-16}]]

Grafico la trayectoria en un giro, ϕ=2π

fig6b=Show[PolarPlot[{rper,raf},{ϕ,0,2π},PlotLegends->{"(Subscript[r, per])","(Subscript[r, af])"},PlotStyle->Dashed,Ticks->None],PolarPlot[r[4/3,ϕ],{ϕ,0,2π},PlotStyle->Black,Ticks->None],AxesLabel->{x,y},Epilog->Text[Style["ϕ=2π",{Gray,13}],Offset[{0,0},Scaled[{1,.3}]],{.95,-28}]]

Export["Ej3fig1a.png",fig6a]
Export["Ej3fig1b.png",fig6b]

Grafico la trayectoria hasta casi que se cierra, ϕ=2π*m

fig7=Show[PolarPlot[{rper,raf},{ϕ,0,2π},PlotLegends->{"(Subscript[r, per])","(Subscript[r, af])"},PlotStyle->Dashed,Ticks->None],PolarPlot[r[4/3,ϕ],{ϕ,0,2π*3-.5},PlotStyle->Black,Ticks->None],AxesLabel->{x,y},Epilog->Text[Style["ϕ=2π*3=6π",{Gray,13}],Offset[{0,0},Scaled[{1,.3}]],{1,-28}]]

Export["Ej3fig2.png",fig7]

Interactivo

Manipulate[Show[{PolarPlot[{rper,raf},{ϕ,0,2π},PlotLegends->{"(Subscript[r, per])","(Subscript[r, af])"},PlotStyle->Dashed,Ticks->None,PlotRange->raf],ParametricPlot[{r[α,ϕ]*Cos[ϕ],r[α,ϕ]*Sin[ϕ]},{ϕ,0,end},PlotStyle->Black,PlotRange->2,PlotRangePadding->.1,ImageSize->{350,350},MaxRecursion->6],Graphics[{RGBColor[.5,0,0],Disk[{r[α,end]*Cos[end],r[α,end]*Sin[end]},.005]}],Graphics[{Green,Rotate[Circle[{-0.2*0.7,0},{0.2,0.2(Sqrt[1-(0.7^2)])}],-(α-1)end,{0,0}]}]}],{α,3/4,4/3},{{end,.001,"animate"},.001,Infinity,ControlType->Trigger},{{end,.001},.001,10,ControlType->None},AutorunSequencing->{3}]

Creo un gif para α=4/3

gif=Table[Show[{PolarPlot[{rper,raf},{ϕ,0,2π},PlotLegends->{"(Subscript[r, per])","(Subscript[r, af])"},PlotStyle->Dashed,Ticks->None,PlotRange->raf,PlotLabel->"α=4/3"],ParametricPlot[{r[4/3,ϕ]*Cos[ϕ],r[4/3,ϕ]*Sin[ϕ]},{ϕ,0,end},PlotStyle->Black,PlotRange->raf],Graphics[{RGBColor[.5,0,0],Disk[{r[4/3,end]*Cos[end],r[4/3,end]*Sin[end]},.005]}],Graphics[{Green,Rotate[Circle[{-0.2*0.7,0},{0.2,0.2(Sqrt[1-(0.7^2)])}],-(4/3-1)end,{0,0}]},PlotRange->raf]}],{end,.00001,6π,π/16}];

Export["Orbita.gif",gif,"DisplayDurations"->Table[.15,{Length[gif]}]]