OFFSET
1,1
COMMENTS
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).
LINKS
Bradley Klee, Table of n, a(n) for n = 1..1537
Bradley Klee, Plane Pendulum and Beyond by Phase Space Geometry, arXiv:1605.09102 [physics.class-ph], 2016.
Bradley Klee, A period function for anharmonic oscillations, Wolfram Community, 2016.
EXAMPLE
n/m 1 2 3 4 5
------------------------------------------
1 | -24 480
2 | -120 6720 3360 -241920 1774080
------------------------------------------
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.
MATHEMATICA
RExp[n_]:=Expand[b Plus[R[0], Total[b^# R[#] & /@ Range[n]]]]
RCalc[n_]:=With[{basis =Subtract[Tally[Join[Range[n + 2], #]][[All, 2]], Table[1, {n + 2}]] & /@ IntegerPartitions[n + 2][[3 ;; -1]]},
Total@ReplaceAll[Times[-2, Multinomial @@ #, v[Total[#]], Times @@ Power[RSet[# - 1] & /@ Range[n + 2], #]] & /@ basis, {Q^2 -> 1, v[2] -> 1/4}]]
dt[n_] := With[{exp = Normal[Series[-1/(1 + x)/.x -> Total[(2 # v[#] RExp[n - 1]^(# - 2) &/@Range[3, n + 2])], {b, 0, n}]]},
Expand@ReplaceAll[Coefficient[exp, b, #] & /@ Range[n], R -> RSet]]
RingGens[n_] :=Times @@ (v /@ #) & /@ (IntegerPartitions[n]/. x_Integer :> x + 2)
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]}]
RSet[0] = 1; Set[RSet[#], Expand@RCalc[#]] & /@ Range[2*7];
tri7 = tri[7]; tri7 // TableForm
PeriodExpansion[tri_, n_] := ReplaceAll[ 1 + Dot[MapThread[ Dot, {tri,
2 RingGens[2 #] & /@ Range[n]}], (2 h)^(Range[n])], {v[m_] :> (v[m]*(1/2)^m)}]
{#, SameQ[Normal@Series[(2/Pi)*EllipticK[k], {k, 0, 7}], #]}&@ReplaceAll[
PeriodExpansion[tri7, 7], {v[n_/; OddQ[n]]:>0, v[n_]:> (-1)^(n/2-1)/2/(n!), h->2 k}]
CROSSREFS
KEYWORD
sign,tabf
AUTHOR
Bradley Klee, Sep 18 2016
STATUS
approved