A276738 Irregular triangle read by rows: T(n,m) = coefficients in a power/Fourier series expansion of an arbitrary anharmonic oscillator's exact phase space trajectory.
-1, -1, 5, -1, 12, -32, -1, 14, 7, -126, 231, -1, 16, 16, -160, -160, 1280, -1792, -1, 18, 18, -198, 9, -396, 1716, -66, 2574, -12870, 14586, -1, 20, 20, -240, 20, -480, 2240, -240, -240, 6720, -17920, 2240, -35840, 129024, -122880, -1, 22, 22, -286, 22, -572, 2860, 11, -572, -286, 8580, -24310, -286, 4290, 8580, -97240, 184756, 715
Offset: 1
Examples
n/m 1 2 3 4 5 6 7 -------------------------------------------- 1 | -1 2 | -1 5 3 | -1 12 -32 4 | -1 14 7 -126 231 5 | -1 16 16 -160 -160 1280 -1792 -------------------------------------------- R[1,Q] = -2*v_3*Q^3 R[2,Q] = -2*v_4*Q^4 + 10*v_3^2*Q^6 R[Q] = b*(1+b*(-2*v_3*Q^3)+b^2*(-2*v_4*Q^4 + 10*v_3^2*Q^6 ))+O(b^4) Construct basis for R[4,Q]; List partitions: {{4}, {3, 1}, {2, 2}, {2, 1, 1}, {1, 1, 1, 1}}; Transform Plus 2: {{v_6}, {v_5, v_3}, {v_4, v_4}, {v_4, v_3, v_3}, {v_3, v_3, v_3, v_3}}; Multiply: {v_6, v_5*v_3, v_4^2, v_4*v_3^2, v_3^4}; don't forget power of Q and factor of 2: {2*v_6*Q^6, 2*v_5*v_3*Q^8, 2*v_4^2*Q^8, 2*v_4*v_3^2*Q^10, 2*v_3^4*Q^12}.
Links
- Bradley Klee, Plane Pendulum and Beyond by Phase Space Geometry, arXiv:1605.09102 [physics.class-ph], 2016.
Crossrefs
Programs
-
Mathematica
R[n_] := b Plus[1, Total[b^# R[#, q] & /@ Range[n]]] Vp[n_] := Total[2 v[# + 2] q^(# + 2) & /@ Range[n]] H[n_] := Expand[1/2*r^2 + Vp[n]] RRules[n_] := With[{H = Series[ReplaceAll[H[n], {q -> R[n] Q, r -> R[n]}], {b, 0, n + 2}]}, Function[{rules}, Nest[Rule[#[[1]], ReplaceAll[#[[2]], rules]] & /@ # &, rules, n]][ Flatten[R[#, q] -> Expand[-ReplaceAll[ Coefficient[H, b^(# + 2)], {R[#, q] -> 0}]] & /@ Range[n]]]] basis[n_] := Times[Times @@ (v /@ #), Q^Total[#],2] & /@ (IntegerPartitions[n] /. x_Integer :> x + 2) TriangleRow[n_, rules_] := With[{term = Expand[rules[[n, 2]]]}, Coefficient[term, #] & /@ basis[n]] With[{rules = RRules[10]}, TriangleRow[#, rules] & /@ Range[10]]
Comments