A273507 T(n, m), denominators of coefficients in a power/Fourier series expansion of the plane pendulum's exact phase space trajectory.
6, 45, 72, 630, 30, 144, 14175, 56700, 3240, 10368, 467775, 42525, 45360, 3888, 62208, 42567525, 2910600, 145800, 272160, 31104, 746496, 1277025750, 3831077250, 471517200, 729000, 13996800, 559872, 497664, 97692469875, 114932317500, 10945935000, 20207880000, 4199040, 124416, 746496, 23887872
Offset: 1
Examples
n/m 1 2 3 4 ------------------------------ 1 | 6 2 | 45, 72 3 | 630, 30, 144 4 | 14175, 56700, 3240, 10368 ------------------------------
Links
- Bradley Klee, Plane Pendulum and Beyond by Phase Space Geometry, arXiv:1605.09102 [physics.class-ph], 2016.
Crossrefs
Programs
-
Mathematica
R[n_] := Sqrt[4 k] Plus[1, Total[k^# R[#, Q] & /@ Range[n]]] Vq[n_] := Total[(-1)^(# - 1) (r Cos[Q] )^(2 #)/((2 #)!) & /@ Range[2, n]] RRules[n_] := With[{H = ReplaceAll[1/2 r^2 + (Vq[n + 1]), {r -> R[n]}]}, Function[{rules}, Nest[Rule[#[[1]], ReplaceAll[#[[2]], rules]] & /@ # &, rules, n]][ Flatten[R[#, Q] -> Expand[(-1/4) ReplaceAll[ Coefficient[H, k^(# + 1)], {R[#, Q] -> 0}]] & /@ Range[n]]]] RCoefficients[n_] := With[{Rn = ReplaceAll[R[n], RRules[n]]}, Function[{a}, Coefficient[Coefficient[Rn/2/Sqrt[k], k^a], Cos[Q]^(2 (a + #))] & /@ Range[a]] /@ Range[n]] Flatten[Denominator@RCoefficients[10]]
Comments