Homework #8 
Connection Coefficients

Off[Clear::wrsym]
Off[General::spell]
Off[General::spell1]

Setup:

colors = {red, green, blue, cyan, magenta, yellow, 
            black} = 
{RGBColor[1, 0, 
              0]
, RGBColor[0, 1, 0]
, 
            RGBColor[0, 0, 1]
, 
            CMYKColor[1, 0, 0, 0]
, 
            CMYKColor[0, 1, 0, 0]
, 
            CMYKColor[0, 0, 1, 0]
, 
            CMYKColor[0, 0, 0, 
              1]
};
Plot[Table[i x, {i, 1, 7}]  // Evaluate, {x, 0, 1}, 
        PlotStyle -> colors];

Protect[{colors, red, green, blue, cyan, magenta, yellow, 
          black}];

Problem #1:
Spherical Coordinates: {θ,ϕ};

Clear["Global`*"]

g = DiagonalMatrix[{(a^2), (a^2) Sin[θ]^2}];     
g  // MatrixForm

gi = Inverse[g];   
gi  // MatrixForm

g . gi

vec = {θ, ϕ};
dvec = {dθ, dϕ};
dvec . g . dvec  // Simplify

Γlow[μ_, α_, β_] := (1/2) (D[
              g[[μ, α]], vec[[β]] ] -  
            D[g[[α, β]], vec[[μ]]] +  
            D[g[[μ, β]], vec[[α]]])

Γ[μ_, α_, β_] :=  
      Sum[gi[[μ, ν]] Γlow[ν, α, β], {ν, 2}]

Table[ {{μ, α, β}, Γlow[μ, α, β]}, {μ, 2}, {α, 2}, {β, 2}]  // 
      MatrixForm

Table[ {{μ, α, β}, Γ[μ, α, β]}, {μ, 2}, {α, 2}, {β, 2}]  // 
      MatrixForm

riemann[μ_, ν_, α_, β_] :=  ( 
        D[ Γ[μ, ν, β], 
            vec[[α]] ]  -   D[ Γ[μ, ν, α], 
            vec[[β]] ]  + 
Sum[ Γ[μ, ρ, α] Γ[ρ, ν, β]  -  Γ[μ, ρ, β] Γ[ρ, ν, α]  , {ρ, 2}])

Table[ {{μ, ν, α, β}, 
            riemann[μ, ν, α, β]}, {μ, 2}, {ν, 
            2}, {α, 2}, {β, 2}]   // Simplify // 
      MatrixForm

Table[ {{μ, ν, α, β}, 
            Sum[gi[[ν, ν1]]  riemann[μ, ν1, μ, β], {ν1, 2}]}, {μ, 2}, {ν, 2}, {α, 2}, {β, 
            2}]   // Simplify // MatrixForm

Table[ {{ν, β}, 
            Sum[gi[[ν, ν1]]  riemann[μ, ν1, μ, β], {μ, 2}, {ν1, 2}]}, {ν, 2}, {β, 2}]   // 
        Simplify // MatrixForm

Sum[
        gi[[ν, ν1]]  riemann[μ, ν1, μ, ν], {μ, 2}, {ν1, 2}, {ν, 2}]  // Simplify

Problem #2:
Hyperbolic Spherical Coordinates: {θ,ϕ};

Clear["Global`*"]

g = DiagonalMatrix[{(a^2), (a^2) Sinh[θ]^2}];    
g  // MatrixForm

gi = Inverse[g];   
gi  // MatrixForm

g . gi

vec = {θ, ϕ};
dvec = {dθ, dϕ};
dvec . g . dvec  // Simplify

Problem #3:
4-D Coordinates:

Clear["Global`*"]

g =  
        DiagonalMatrix[{1, - (a^2), -(r^2),  -(r^2) 
              Sin[θ]^2}];    
g  // MatrixForm

gi = Inverse[g];   
gi  // MatrixForm

g . gi

vec = {t, r, θ, ϕ};
dvec = {dt, dr, dθ, dϕ};
dvec . g . dvec  // Simplify

Problem #4
Precession of Mercury:

Clear["Global`*"]

eq1 =   - energy +  
        b/(2 r[ϕ]^2) ( 
            1/r[ϕ]^2 D[r[ϕ], ϕ]^2  +  1  -  
              eps rs/r[ϕ] )  -  G M /r[ϕ]

eqR =  
      r[ϕ] ==  
        rmin (1 + e)/(1 + 
                e Cos[ϕ] + α[ϕ])

dsol1 =  DSolve[ eqR , r, ϕ][[1]]

eq2 =  eq1  /. 
            dsol1  /. {eps -> 
              0}  /. {α -> (0 &)}

eq3 =  
      eq2 == 0 /. {ϕ -> {0, π}}  // Thread

sol1 =  Solve[eq3, {b, rmin}][[1]]  // Simplify

eq1  /. dsol1  //. 
            sol1  /. {eps -> 0}  /. {α -> (0 &)} // 
      Simplify

eq4 =  eq1   /. eps -> 1  // Simplify

eq4 =  eq1  /. 
          dsol1   /. eps->1