cp's OEIS Frontend

This is a front-end for the Online Encyclopedia of Integer Sequences, made by Christian Perfect. The idea is to provide OEIS entries in non-ancient HTML, and then to think about how they're presented visually. The source code is on GitHub.

Showing 1-4 of 4 results.

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.

Original entry on oeis.org

-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

Views

Author

Bradley Klee, Sep 16 2016

Keywords

Comments

Irregular triangle read by rows (see examples). Consider an arbitrary anharmonic oscillator with Hamiltonian energy: H=(1/2)*b^2=(1/2)*(p^2+q^2) + Sum_{i=3} 2*v_i*q^i, and a stable minimum at (p,q)=(0,0). The phase space trajectory can be written in polar phase space coordinates as (q,p) = (R(x)cos(x),R(x)sin(x))=(R(Q)Q,R(Q)P). The present triangle determines a power / Fourier series of R(Q): R(Q) = b * (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 constructed from partitions of "n" listed in reverse lexicographic order. Partition n=(z_1+z_2+...z_j) becomes 2*Q^((z_1+2)+(z_2+2)+...(z_j+2))*v_{z_1+2}*v_{z_2+2}*...*v_{z_j+2} (see examples). This sequence transforms into A273506/A273507 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).

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

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]]

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

Original entry on oeis.org

-24, 480, -120, 6720, 3360, -241920, 1774080, -560, 40320, 40320, -1774080, 20160, -3548160, 61501440, -591360, 92252160, -1845043200, 8364195840, -2520, 221760, 221760, -11531520, 221760, -23063040, 461260800, 110880, -23063040, -11531520, 1383782400, -15682867200, -11531520, 691891200, 1383782400, -62731468800, 476759162880
Offset: 1

Views

Author

Bradley Klee, Sep 18 2016

Keywords

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

Examples

			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.
		

Crossrefs

Programs

  • 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}]

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

Original entry on oeis.org

-1, 2, 6, -3, -16, 8, -48, 4, 30, -20, 140, 10, -140, 420, -5, -48, 36, -288, -24, 384, -1280, 12, -192, -96, 1920, -3840, 6, 70, -56, 504, 42, -756, 2772, -28, 504, 252, -5544, 12012, 14, -252, -252, 2772, 2772, -24024, 36036, -7, -96, 80, -800, -64, 1280, -5120, 48, -960, -480, 11520, -26880, -32, 640, 640, -7680
Offset: 0

Views

Author

Bradley Klee, Sep 18 2016

Keywords

Comments

Irregular triangle read by rows (see examples).
Consider an axially symmetric oscillator in two dimensions with polar coordinates ( r, y ). By conservation of angular momentum, replace the cyclic angle coordinate y with dy/dt = 1/r^2. The system becomes one-dimensional in r, with an effective potential including the 1/r^2 term. Assume that the effective potential has a minimum around r0 and apply a linear transform r --> q = r-r0. Radial oscillations around the effective potential minimum follow the exact solution of A276738, A276814, A276815, A276816. Now dy = dx (dy/dt) / (dx/dt) = dx * Sum b^n*T(n,m)*F(n,m), with n=1,2,3.... and m=1,2,3...A000070(n). Basis functions F(n,m) are an ordered union over A276738's f(n,m): F(n,m')={ (1/r0^2)*(Q/r0)^n } & Append_{i=1..n}_{m=1..A000041(n)} (1/2/r0^2)*(Q/r0)^(n - i)*f(i,m), where each successive term f(i,m) is appended such that index m' inherets the ordering of each m index (see examples). Integrating dx over a range of 2 Pi loses all odd rows, as in A276815 / A276816. This sequence is a useful tool in classical and relativistic astronomy (follow links to Wolfram demonstrations).

Examples

			n/m   1   2    3    4      5     6    7
------------------------------------------
0  | -1
1  |  2   6
2  | -3  -16   8   -48
3  |  4   30  -20   140   10   -140   420
------------------------------------------
Construction of F(2,_). List f(i,_) basis sets: {f(1,_)={2*Q^3*v_3},f(2,_)= {2*Q^4*v_4, 2*Q^6*v_3^2}}; Integrate and join: F(2,_)={(1/r0^2)*(Q/r0)^2,2*Q^3*v_3*(1/2/r0^2)*(Q/r0),2*Q^4*v_4*(1/2/r0^2), 2*Q^6*v_3^2*(1/2/r0^2)}={Q^2/r0^4,Q^4*v_3/r0^3,Q^4*v_4/r0^2,Q^6*v_3^2/r0^2}.
dy Expansion to second order: dy=dx(-(1/r0^2)+b^2*(2*Q/r0^3 + 6*Q^3*v_3/r0^2)+b^3*(-3*Q^2/r0^4 - 16*Q^4*v_3/r0^3 - 48*Q^6*v_3^2/r0^2 + 8*Q^4*v_4/r0^2)+O(b^3).
Cancellation of higher orders 1 to infinity and closed orbits. Kepler values {r0 = 1, v_n := ((n - 1)/4)*(-1)^n} yield dy = -dx. Harmonic oscillator values {r0 = Sqrt[2], v_n := ((-1)^n*(n + 1)/4/2)/sqrt[2]^n} yield dy = -(1/2)*dx. Parity symmetric conjectured values {r0=Sqrt[1/R],v_n odd n := 0,v_n even n := R^(n/2 - 1)*(n/8)} yield dy = -R*dx (see attached image "Pentagonal Orbits")?
		

References

  • R. M. Wald, General Relativity, University of Chicago press, 2010, pages 139-143.
  • J.A. Wheeler, A Journey into Gravity and Spacetime, Scientific American Library, 1990, pages 168-183.

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}]
    ydot[n__] := Expand[Normal@Series[1/(r0 + q)^2 /. {q -> R[n] Q} /. RRules[n], {b, 0, n}]]
    dy[n_] := Expand@Normal@Series[ydot[n]/xDot[n], {b, 0, n}]
    basis[n_] :=  Times[Times @@ (v /@ #), Q^Total[#],2] & /@ (IntegerPartitions[n] /. x_Integer :> x + 2)
    extendedBasis[n_] :=Flatten[(1/2/r0^2) (Q/r0)^(n - #) basis[#] & /@ Range[0, n]]
    TriangleRow[n_, func_] := Coefficient[func, b^n #] & /@ extendedBasis[n]
    With[{dy5 = dy[5]}, TriangleRow[#, dy5] /. v[_] -> 0 & /@ Range[0, 5]]
    (*Kepler Test*)TrigReduce[dy[5] /. {Q -> Cos[x]}] /. {r0 -> 1, Cos[] -> 0, v[n] :> ((n - 1)/4)*(-1)^n}
    (*Harmonic Test*)TrigReduce[dy[5] /. {Q -> Cos[x]}] /. {Cos[] -> 0, v[n] :> ((-1)^n*(n + 1)/4/2)/Sqrt[2]^n, r0 -> Sqrt[2]}
    (*Conjecture*)TrigReduce[dy[5] /. {Q -> Cos[x]}] /. {Cos[] -> 0, v[n /; OddQ[n]] :> 0, v[n_] :> RR^(n/2 - 1)*n/8, r0 -> Sqrt[1/RR]}

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.

Original entry on oeis.org

-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

Views

Author

Bradley Klee, Sep 18 2016

Keywords

Comments

Irregular triangle read by rows ( see examples ). The phase space trajectory of A276738 has one time dependent variable, the phase space angle "x" defined as Tan[x]=p/q. Then dx/dt = cos[x]^2* d/dt(p/q), which can be written as a function of Q=cos[x] by application of the classical equations of motion d/dt(p,q) = ( -d/dq H, d/dp H ), with H the anharmonic oscillator Hamiltonian. Substituting the result of A276738 and expanding in powers of b, we obtain dx/dt = -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. Observe the limit where Q --> 0, dx/dt --> -1, the harmonic oscillator value. Similarly if v_i --> 0 then dx/dt --> -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
---------------------------------------------
		

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]]
Showing 1-4 of 4 results.