A276814 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.
-3, -4, 6, -5, 22, -30, -6, 36, 16, -168, 192, -7, 54, 46, -294, -266, 1428, -1386, -8, 76, 64, -480, 30, -832, 2560, -128, 3520, -12800, 10752, -9, 102, 86, -738, 78, -1260, 4356, -594, -558, 11484, -23166, 3564, -42900, 118404, -87516, -10, 132, 112, -1080, 100, -1840, 7040, 48, -1680, -800, 18240, -40320, -760, 8640
Offset: 1
Examples
n/m 1 2 3 4 5 6 7 --------------------------------------------- 1 | -3 2 | -4, 6 3 | -5, 22, -30 4 | -6, 36, 16, -168 192 5 | -7, 54, 46, -294 -266 1428 -1386 ---------------------------------------------
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]]]] 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}] -> ReplaceAll[D[-(q^2/2 + Vp[n]), q], q -> R[n] Q]} ], {b, 0, n}] /. RRules[n] /. {P^2 -> 1 - Q^2}] basis[n_] := Times[Times @@ (v /@ #), Q^Total[#],2] & /@ (IntegerPartitions[n] /. x_Integer :> x + 2) TriangleRow[n_, fun_] := Coefficient[fun, b^n #] & /@ basis[n] With[{xd = xDot[10]},TriangleRow[#, xd] /. v[_] -> 0 & /@ Range[10]]
Comments