Mathematica in Celestial Mechanics: A Sampling

The advanced symbolic and other capabilities of Mathematica make it the ideal tool for solving problems in the field for which calculus and much of modern mathematics was originally invented.

Zero Velocity Curves in the Restricted Three Body Problem

(Subscript[ρ, 0]) = (Sqrt[(((x +  μ a))^2)  +  (y^2)]); 
    (Subscript[ρ, 1]) = (Sqrt[(((x - (1 -  μ) a))^2)  +  (y^2)]);
Ω[μ_, a_] = 
        (1 - μ) ((1/(Subscript[ρ, 0]))  +  (((Subscript[ρ, 0])^2)/2))  +  
          μ ((1/(Subscript[ρ, 1]))  +  (((Subscript[ρ, 1])^2)/2));

\(\(ContourPlot[Ω[1\/10, 1], 	{x, \(-\(3\/2\)\), 3\/2}, 
        {y, \(-\(3\/2\)\), 3\/2}, PlotPoints -> 30, 
        ColorFunction -> Hue];\)\)

Series Solution of Newton's Equation

(Subscript[𝒟, t])[Σ_Plus]  :=  
      (Subscript[𝒟, t])[#]& /@ Σ

(Subscript[𝒟, t])[Π_Times] := 
      Plus@@MapIndexed[MapAt[(Subscript[𝒟, t]), ##]&, 
          Array[Π&, Length[Π]]]

(Subscript[𝒟, t])[_?(FreeQ[#, r[t]  |  R[t]]&)] := 0

(Subscript[𝒟, t])[r[t]^n_. ] := 
      n r[t]^(n - 2) R[t]⊙(Subscript[𝒟, t])[R[t]]

(Subscript[𝒟, t])[a_⊙b_] := 
      (Subscript[𝒟, t])[a]⊙b + 
        a⊙(Subscript[𝒟, t])[b]

(Subscript[𝒟, t])[
        (((R[t]⊙(Subscript[𝒟, t])[R[t]]))^n)_] := 
      n (((R[t]⊙(Subscript[𝒟, t])[R[t]]))^(n - 1)) 
        (Subscript[𝒟, t])[R[t]⊙(Subscript[𝒟, t])[R[t]]]

(Subscript[𝒟, t])[(Subscript[𝒟, t])[R[t]]] := 
      -R[t]/r[t]^3;

SetAttributes[CircleDot,  Orderless]

(𝒻_?(FreeQ[#, R[t] | (Subscript[𝒟, t])[R[t]]]&) b_)
          ⊙c_ := 𝒻 b⊙c

R[t]⊙R[t] := r[t]^2

(Subscript[𝒯, 0])  :=  R[t]

(Subscript[𝒯, n])_  :=  
      (Subscript[𝒯, n])  =  
        Expand[(Subscript[𝒟, t])[(Subscript[𝒯, n - 1])]];

{𝓈[(Subscript[𝒯, 0])], 𝓈[(Subscript[𝒯, 1])], 
        𝓈[(Subscript[𝒯, 2])]} = {{1, 0}, {0, 1}, {-u, 0}};

\(𝓈[𝒯_] := 
      \(Function[p, 
          Factor[Apply[Plus, 
					
              \(Cases[p, _. \ #]/#&\)\ /@{R[t], 𝒟\_t[R[t]]}, {
                1}]]]\)[
			
        \(𝒯 //. {
              𝒟\_t[R[t]]⊙R[t] -> 
                σ\ r[t]\^2, \ \ 
						\ \ \ \ \ \ \ 
              𝒟\_t[R[t]]⊙𝒟\_t[
                    R[t]] -> ω\ r[t]\^2}\) //. {
            r[t]\^n_ -> μ\^\(-\(n\/3\)\)}]\)

𝔑𝔢𝔴𝔱𝔬𝔫𝔖𝔢𝔯𝔦𝔢𝔰[o_] :=  
      (∑_(i = 0)^o)
           ((t^i)/(i!)) {(Subscript[r, 0]), (Subscript[v, 0])} . 𝓈[(Subscript[𝒯, i])]

𝔑𝔢𝔴𝔱𝔬𝔫𝔖𝔢𝔯𝔦𝔢𝔰[1]

𝔑𝔢𝔴𝔱𝔬𝔫𝔖𝔢𝔯𝔦𝔢𝔰[2]

𝔑𝔢𝔴𝔱𝔬𝔫𝔖𝔢𝔯𝔦𝔢𝔰[3]

𝔑𝔢𝔴𝔱𝔬𝔫𝔖𝔢𝔯𝔦𝔢𝔰[6]

Poisson Series Expansion for the Center in Kepler Motion

(Subscript[f, 0, n_]) := 0

(Subscript[f, k_, n_]) := 
      (Subscript[f, k, n]) = 
        ∫Series[
              ((((1 + ϵ Cos[μ + (Subscript[f, k - 1, n])]))^2)/((Sqrt[(1 + ((ϵ )^2))])^3)) - 1, {ϵ, 0, n}] 
            \[DifferentialD]μ

(Subscript[f, 2, 2])

(Subscript[f, 6, 6])

Riemann Surface for the Kepler Equation

e - m - ϵ  sin(e) = 0