|
%I #16 Jan 10 2018 20:27:58
%S 3,4,-24,5,-70,210,6,-96,-48,960,-1920,7,-126,-126,1386,1386,-12012,
%T 18018,8,-160,-160,1920,-80,3840,-17920,640,-26880,143360,-172032,9,
%U -198,-198,2574,-198,5148,-25740,2574,2574,-77220,218790,-25740,437580,-1662804,1662804,10,-240,-240,3360,-240,6720,-35840,-120,6720,3360
%N Irregular triangle read by rows T(n,m), coefficients in power/Fourier series expansion of an arbitrary anharmonic oscillator's exact differential time dependence.
%C The phase space trajectory A276738 has phase space angular velocity A276814, which allows expansion of dt = dx /(dx/dt) = dx(-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. To obtain period K, we integrate the function of Q=cos[x] over a range of [2*pi,0]. All odd powers of Q integrate to zero, so the period is an expansion in E=(1/2)*b^2 (Cf. A276816). This sequence transforms into A274076/A274078 by setting v_i=0 for odd i, v_i=(-1)^(i/2-1)/2/(i!) otherwise, and (1/2)*b^2 = 2*k. For more details read "Plane Pendulum and Beyond by Phase Space Geometry" (Klee, 2016).
%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 -24
%e 3 | 5 -70 210
%e 4 | 6 -96 -48 960 -1920
%e 5 | 7 -126 -126 1386 1386 -12012 18018
%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 dt[n_] := Expand[Normal@Series[1/xDot[n], {b, 0, n}]]
%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[{dt10 = dt[10]}, TriangleRow[#, dt10] /. v[_] -> 0 & /@ Range[10]]
%Y Arbitrary Oscillator: A276738, A276814, A276816, A276817.
%Y 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
|
