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

%I #37 Dec 25 2016 14:34:28

%S -24,480,-120,6720,3360,-241920,1774080,-560,40320,40320,-1774080,

%T 20160,-3548160,61501440,-591360,92252160,-1845043200,8364195840,

%U -2520,221760,221760,-11531520,221760,-23063040,461260800,110880,-23063040,-11531520,1383782400,-15682867200,-11531520,691891200,1383782400,-62731468800,476759162880

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

%C The phase space trajectory A276738 has phase space angular velocity A276814 and differential time dependence A276815. We calculate the period K = Int dt over the range [2*Pi, 0], trivial to compute from A276815 using A273496. Then K/(2*Pi) = 1 + sum b^(2n)*T(n,m)*f'(n,m); where the sum runs over n = 1, 2, 3 ... and m = 1, 2, 3, ... A000041(2n), and f'(n,m) = f(2n,m) of A276738 with Q=1/2. Choosing one point from the infinite dimensional coefficient space--v_i=0 for odd i, v_i=(-1)^(i/2-1)/2/(i!) otherwise--setting b^2 = 4*k, and summing over the entire table obtains the EllipticK expansion 2*A038534/A038533. For more details read "Plane Pendulum and Beyond by Phase Space Geometry" (Klee, 2016).

%H Bradley Klee, <a href="/A276816/b276816.txt">Table of n, a(n) for n = 1..1537</a>

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

%H Bradley Klee, <a href="http://community.wolfram.com/groups/-/m/t/984488">A period function for anharmonic oscillations</a>, Wolfram Community, 2016.

%e n/m 1 2 3 4 5

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

%e 1 | -24 480

%e 2 | -120 6720 3360 -241920 1774080

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

%e For pendulum values, f'(1,*)={(-1/384), 0}, f'(2,*) = {1/46080, 0, 1/294912, 0, 0}. Then K/(2Pi) = 1+(-1/384)*(-24)*4*k+((1/46080)*(-120)+(1/294912)*3360)*16*k^2=1+(1/4)*k + (9/64)*k^2, the first few terms of EllipticK.

%t RExp[n_]:=Expand[b Plus[R[0], Total[b^# R[#] & /@ Range[n]]]]

%t RCalc[n_]:=With[{basis =Subtract[Tally[Join[Range[n + 2], #]][[All, 2]],Table[1, {n + 2}]] & /@ IntegerPartitions[n + 2][[3 ;; -1]]},

%t Total@ReplaceAll[Times[-2, Multinomial @@ #, v[Total[#]],Times @@ Power[RSet[# - 1] & /@ Range[n + 2], #]] & /@ basis, {Q^2 -> 1, v[2] -> 1/4}]]

%t dt[n_] := With[{exp = Normal[Series[-1/(1 + x)/.x -> Total[(2 # v[#] RExp[n - 1]^(# - 2) &/@Range[3, n + 2])], {b, 0, n}]]},

%t Expand@ReplaceAll[Coefficient[exp, b, #] & /@ Range[n], R -> RSet]]

%t RingGens[n_] :=Times @@ (v /@ #) & /@ (IntegerPartitions[n]/. x_Integer :> x + 2)

%t tri[m_] := MapThread[Function[{a, b},Times[-# /. v[n_] :> Q^n /. Q^n_ :> Binomial[n, n/2],(1/2) Coefficient[a, #]] & /@ b], {dt[2 m][[2 #]] & /@ Range[m], RingGens[2 #] & /@ Range[m]}]

%t RSet[0] = 1; Set[RSet[#], Expand@RCalc[#]] & /@ Range[2*7];

%t tri7 = tri[7]; tri7 // TableForm

%t PeriodExpansion[tri_, n_] := ReplaceAll[ 1 + Dot[MapThread[ Dot, {tri,

%t 2 RingGens[2 #] & /@ Range[n]}], (2 h)^(Range[n])], {v[m_] :> (v[m]*(1/2)^m)}]

%t {#,SameQ[Normal@Series[(2/Pi)*EllipticK[k],{k,0,7}],#]}&@ReplaceAll[

%t PeriodExpansion[tri7,7],{v[n_/;OddQ[n]]:>0,v[n_]:> (-1)^(n/2-1)/2/(n!),h->2 k}]

%Y Arbitrary Oscillator: A276738, A276814, A276815, A276817.

%Y Pendulum: A273506, A273507, A274076, A274078, A274130, A274131, A038534, A056982, A000984, A001790, A038533, A046161, A273496.

%Y EllipticK: A038534, A038533.

%Y Partition Triangles: A263633, A080577, A036038, A036040, A080575, A178867.

%K sign,tabf

%O 1,1

%A _Bradley Klee_, Sep 18 2016