OFFSET
0,2
COMMENTS
Irregular triangle read by rows (see examples).
Consider an axially symmetric oscillator in two dimensions with polar coordinates ( r, y ). By conservation of angular momentum, replace the cyclic angle coordinate y with dy/dt = 1/r^2. The system becomes one-dimensional in r, with an effective potential including the 1/r^2 term. Assume that the effective potential has a minimum around r0 and apply a linear transform r --> q = r-r0. Radial oscillations around the effective potential minimum follow the exact solution of A276738, A276814, A276815, A276816. Now dy = dx (dy/dt) / (dx/dt) = dx * Sum b^n*T(n,m)*F(n,m), with n=1,2,3.... and m=1,2,3...A000070(n). Basis functions F(n,m) are an ordered union over A276738's f(n,m): F(n,m')={ (1/r0^2)*(Q/r0)^n } & Append_{i=1..n}_{m=1..A000041(n)} (1/2/r0^2)*(Q/r0)^(n - i)*f(i,m), where each successive term f(i,m) is appended such that index m' inherets the ordering of each m index (see examples). Integrating dx over a range of 2 Pi loses all odd rows, as in A276815 / A276816. This sequence is a useful tool in classical and relativistic astronomy (follow links to Wolfram demonstrations).
REFERENCES
R. M. Wald, General Relativity, University of Chicago press, 2010, pages 139-143.
J.A. Wheeler, A Journey into Gravity and Spacetime, Scientific American Library, 1990, pages 168-183.
LINKS
Bradley Klee, Plane Pendulum and Beyond by Phase Space Geometry, arXiv:1605.09102 [physics.class-ph], 2016.
Bradley Klee, Estimating Planetary Perihelion Precession, Wolfram Demonstrations Project, 2106.
Bradley Klee, Exact and Approximate Relativistic Corrections to the Orbital Precession of Mercury, Wolfram Demonstrations Project, 2016.
Bradley Klee, Pentagonal Orbits
Seqfans, Another planetary sequence, Seqfans mailing list, September 2016.
EXAMPLE
n/m 1 2 3 4 5 6 7
------------------------------------------
0 | -1
1 | 2 6
2 | -3 -16 8 -48
3 | 4 30 -20 140 10 -140 420
------------------------------------------
Construction of F(2,_). List f(i,_) basis sets: {f(1,_)={2*Q^3*v_3},f(2,_)= {2*Q^4*v_4, 2*Q^6*v_3^2}}; Integrate and join: F(2,_)={(1/r0^2)*(Q/r0)^2,2*Q^3*v_3*(1/2/r0^2)*(Q/r0),2*Q^4*v_4*(1/2/r0^2), 2*Q^6*v_3^2*(1/2/r0^2)}={Q^2/r0^4,Q^4*v_3/r0^3,Q^4*v_4/r0^2,Q^6*v_3^2/r0^2}.
dy Expansion to second order: dy=dx(-(1/r0^2)+b^2*(2*Q/r0^3 + 6*Q^3*v_3/r0^2)+b^3*(-3*Q^2/r0^4 - 16*Q^4*v_3/r0^3 - 48*Q^6*v_3^2/r0^2 + 8*Q^4*v_4/r0^2)+O(b^3).
Cancellation of higher orders 1 to infinity and closed orbits. Kepler values {r0 = 1, v_n := ((n - 1)/4)*(-1)^n} yield dy = -dx. Harmonic oscillator values {r0 = Sqrt[2], v_n := ((-1)^n*(n + 1)/4/2)/sqrt[2]^n} yield dy = -(1/2)*dx. Parity symmetric conjectured values {r0=Sqrt[1/R],v_n odd n := 0,v_n even n := R^(n/2 - 1)*(n/8)} yield dy = -R*dx (see attached image "Pentagonal Orbits")?
MATHEMATICA
R[n_] := b Plus[1, Total[b^# R[#, q] & /@ Range[n]]]
Vp[n_] := Total[2 v[# + 2] q^(# + 2) & /@ Range[n]]
H[n_] := Expand[1/2*r^2 + Vp[n]]
RRules[n_] := With[{H = Series[ReplaceAll[H[n], {q -> R[n] Q, r -> R[n]}], {b, 0, n + 2}]}, Function[{rules},
Nest[Rule[#[[1]], ReplaceAll[#[[2]], rules]] & /@ # &, rules, n]][
Flatten[R[#, q] -> Expand[-ReplaceAll[ Coefficient[H, b^(# + 2)], {R[#, q] -> 0}]] & /@ Range[n]]]]
xDot[n_] := Expand[Normal@Series[ReplaceAll[ Q^2 D[D[q[t], t]/q[t], t], {D[q[t], t] -> R[n] P, q[t] -> R[n] Q, r -> R[n], D[q[t], {t, 2}]
-> ReplaceAll[D[-(q^2/2 + Vp[n]), q], q -> R[n] Q]} ], {b, 0, n}] /. RRules[n] /. {P^2 -> 1 - Q^2}]
ydot[n__] := Expand[Normal@Series[1/(r0 + q)^2 /. {q -> R[n] Q} /. RRules[n], {b, 0, n}]]
dy[n_] := Expand@Normal@Series[ydot[n]/xDot[n], {b, 0, n}]
basis[n_] := Times[Times @@ (v /@ #), Q^Total[#], 2] & /@ (IntegerPartitions[n] /. x_Integer :> x + 2)
extendedBasis[n_] :=Flatten[(1/2/r0^2) (Q/r0)^(n - #) basis[#] & /@ Range[0, n]]
TriangleRow[n_, func_] := Coefficient[func, b^n #] & /@ extendedBasis[n]
With[{dy5 = dy[5]}, TriangleRow[#, dy5] /. v[_] -> 0 & /@ Range[0, 5]]
(*Kepler Test*)TrigReduce[dy[5] /. {Q -> Cos[x]}] /. {r0 -> 1, Cos[_] -> 0, v[n_] :> ((n - 1)/4)*(-1)^n}
(*Harmonic Test*)TrigReduce[dy[5] /. {Q -> Cos[x]}] /. {Cos[_] -> 0, v[n_] :> ((-1)^n*(n + 1)/4/2)/Sqrt[2]^n, r0 -> Sqrt[2]}
(*Conjecture*)TrigReduce[dy[5] /. {Q -> Cos[x]}] /. {Cos[_] -> 0, v[n_ /; OddQ[n]] :> 0, v[n_] :> RR^(n/2 - 1)*n/8, r0 -> Sqrt[1/RR]}
CROSSREFS
KEYWORD
sign,tabf
AUTHOR
Bradley Klee, Sep 18 2016
STATUS
approved