cp's OEIS Frontend

A276817 Irregular triangle read by rows: T(n,m) = coefficients in power/Fourier series expansion of an arbitrary anharmonic oscillator's exact differential precession.

%I A276817 #33 Dec 23 2024 14:53:44
%S A276817 -1,2,6,-3,-16,8,-48,4,30,-20,140,10,-140,420,-5,-48,36,-288,-24,384,
%T A276817 -1280,12,-192,-96,1920,-3840,6,70,-56,504,42,-756,2772,-28,504,252,
%U A276817 -5544,12012,14,-252,-252,2772,2772,-24024,36036,-7,-96,80,-800,-64,1280,-5120,48,-960,-480,11520,-26880,-32,640,640,-7680
%N A276817 Irregular triangle read by rows: T(n,m) = coefficients in power/Fourier series expansion of an arbitrary anharmonic oscillator's exact differential precession.
%C A276817 Irregular triangle read by rows (see examples).
%C A276817 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).
%D A276817 R. M. Wald, General Relativity, University of Chicago press, 2010, pages 139-143.
%D A276817 J.A. Wheeler, A Journey into Gravity and Spacetime, Scientific American Library, 1990, pages 168-183.
%H A276817 Bradley Klee, <a href="http://arxiv.org/abs/1605.09102">Plane Pendulum and Beyond by Phase Space Geometry</a>, arXiv:1605.09102 [physics.class-ph], 2016.
%H A276817 Bradley Klee, <a href="http://demonstrations.wolfram.com/EstimatingPlanetaryPerihelionPrecession/">Estimating Planetary Perihelion Precession</a>, Wolfram Demonstrations Project, 2106.
%H A276817 Bradley Klee, <a href="http://demonstrations.wolfram.com/ExactAndApproximateRelativisticCorrectionsToTheOrbitalPreces/">Exact and Approximate Relativistic Corrections to the Orbital Precession of Mercury</a>, Wolfram Demonstrations Project, 2016.
%H A276817 Bradley Klee, <a href="/A276817/a276817.png">Pentagonal Orbits</a>
%H A276817 Seqfans, <a href="https://web.archive.org/web/*/http://list.seqfan.eu/oldermail/seqfan/2016-September/thread.html">Another planetary sequence</a>, Seqfans mailing list, September 2016.
%e A276817 n/m   1   2    3    4      5     6    7
%e A276817 ------------------------------------------
%e A276817 0  | -1
%e A276817 1  |  2   6
%e A276817 2  | -3  -16   8   -48
%e A276817 3  |  4   30  -20   140   10   -140   420
%e A276817 ------------------------------------------
%e A276817 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}.
%e A276817 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).
%e A276817 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")?
%t A276817 R[n_] := b Plus[1, Total[b^# R[#, q] & /@ Range[n]]]
%t A276817 Vp[n_] := Total[2 v[# + 2] q^(# + 2) & /@ Range[n]]
%t A276817 H[n_] := Expand[1/2*r^2 + Vp[n]]
%t A276817 RRules[n_] :=  With[{H = Series[ReplaceAll[H[n], {q -> R[n] Q, r -> R[n]}], {b, 0, n + 2}]},  Function[{rules},
%t A276817     Nest[Rule[#[[1]], ReplaceAll[#[[2]], rules]] & /@ # &, rules, n]][
%t A276817    Flatten[R[#, q] -> Expand[-ReplaceAll[ Coefficient[H, b^(# + 2)], {R[#, q] -> 0}]] & /@ Range[n]]]]
%t A276817 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}]
%t A276817 ->  ReplaceAll[D[-(q^2/2 + Vp[n]), q], q -> R[n] Q]} ], {b, 0, n}] /. RRules[n] /. {P^2 -> 1 - Q^2}]
%t A276817 ydot[n__] := Expand[Normal@Series[1/(r0 + q)^2 /. {q -> R[n] Q} /. RRules[n], {b, 0, n}]]
%t A276817 dy[n_] := Expand@Normal@Series[ydot[n]/xDot[n], {b, 0, n}]
%t A276817 basis[n_] :=  Times[Times @@ (v /@ #), Q^Total[#],2] & /@ (IntegerPartitions[n] /. x_Integer :> x + 2)
%t A276817 extendedBasis[n_] :=Flatten[(1/2/r0^2) (Q/r0)^(n - #) basis[#] & /@ Range[0, n]]
%t A276817 TriangleRow[n_, func_] := Coefficient[func, b^n #] & /@ extendedBasis[n]
%t A276817 With[{dy5 = dy[5]}, TriangleRow[#, dy5] /. v[_] -> 0 & /@ Range[0, 5]]
%t A276817 (*Kepler Test*)TrigReduce[dy[5] /. {Q -> Cos[x]}] /. {r0 -> 1, Cos[_] -> 0, v[n_] :> ((n - 1)/4)*(-1)^n}
%t A276817 (*Harmonic Test*)TrigReduce[dy[5] /. {Q -> Cos[x]}] /. {Cos[_] -> 0, v[n_] :> ((-1)^n*(n + 1)/4/2)/Sqrt[2]^n, r0 -> Sqrt[2]}
%t A276817 (*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]}
%Y A276817 Arbitrary Oscillator: A276738, A276814, A276815, A276816.
%Y A276817 Pendulum: A273506, A273507, A274076, A274078, A274130, A274131, A038534, A056982, A000984, A001790, A038533, A046161, A273496.
%K A276817 sign,tabf
%O A276817 0,2
%A A276817 _Bradley Klee_, Sep 18 2016