login
Irregular triangle read by rows T(n,m), coefficients in power/Fourier series expansion of an arbitrary anharmonic oscillator's exact phase space angular velocity.
4

%I #17 Jan 10 2018 20:27:38

%S -3,-4,6,-5,22,-30,-6,36,16,-168,192,-7,54,46,-294,-266,1428,-1386,-8,

%T 76,64,-480,30,-832,2560,-128,3520,-12800,10752,-9,102,86,-738,78,

%U -1260,4356,-594,-558,11484,-23166,3564,-42900,118404,-87516,-10,132,112,-1080,100,-1840,7040,48,-1680,-800,18240,-40320,-760,8640

%N Irregular triangle read by rows T(n,m), coefficients in power/Fourier series expansion of an arbitrary anharmonic oscillator's exact phase space angular velocity.

%C Irregular triangle read by rows ( see examples ). The phase space trajectory of A276738 has one time dependent variable, the phase space angle "x" defined as Tan[x]=p/q. Then dx/dt = cos[x]^2* d/dt(p/q), which can be written as a function of Q=cos[x] by application of the classical equations of motion d/dt(p,q) = ( -d/dq H, d/dp H ), with H the anharmonic oscillator Hamiltonian. Substituting the result of A276738 and expanding in powers of b, we obtain dx/dt = -1 + sum b^n*T(n,m)*f(n,m); where the sum runs over n=1,2,3... and m = 1,2,3, ... A000041(n). The basis functions f(n,m) are the same as in A276738. Observe the limit where Q --> 0, dx/dt --> -1, the harmonic oscillator value. Similarly if v_i --> 0 then dx/dt --> -1.

%H 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.

%e n/m 1 2 3 4 5 6 7

%e ---------------------------------------------

%e 1 | -3

%e 2 | -4, 6

%e 3 | -5, 22, -30

%e 4 | -6, 36, 16, -168 192

%e 5 | -7, 54, 46, -294 -266 1428 -1386

%e ---------------------------------------------

%t R[n_] := b Plus[1, Total[b^# R[#, q] & /@ Range[n]]]

%t Vp[n_] := Total[2 v[# + 2] q^(# + 2) & /@ Range[n]]

%t H[n_] := Expand[1/2*r^2 + Vp[n]]

%t RRules[n_] := With[{H = Series[ReplaceAll[H[n], {q -> R[n] Q, r -> R[n]}], {b, 0, n + 2}]}, Function[{rules},

%t Nest[Rule[#[[1]], ReplaceAll[#[[2]], rules]] & /@ # &, rules, n]][

%t Flatten[R[#, q] -> Expand[-ReplaceAll[ Coefficient[H, b^(# + 2)], {R[#, q] -> 0}]] & /@ Range[n]]]]

%t 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 -> ReplaceAll[D[-(q^2/2 + Vp[n]), q], q -> R[n] Q]} ], {b, 0, n}] /. RRules[n] /. {P^2 -> 1 - Q^2}]

%t basis[n_] := Times[Times @@ (v /@ #), Q^Total[#],2] & /@ (IntegerPartitions[n] /. x_Integer :> x + 2)

%t TriangleRow[n_, fun_] := Coefficient[fun, b^n #] & /@ basis[n]

%t With[{xd = xDot[10]},TriangleRow[#, xd] /. v[_] -> 0 & /@ Range[10]]

%Y Arbitrary Oscillator: A276738, A276815,A276816,A276817. Pendulum: A273506, A273507, A274076, A274078, A274130, A274131, A038534, A056982, A000984, A001790, A038533, A046161, A273496.

%K sign,tabf

%O 1,1

%A _Bradley Klee_, Sep 18 2016