Comparison of degree polynomials

Marko Petkovsek & Christian Weixlbaumer

Clear[DegPoly, Coef];

Unprotect[Power];
0^0 = 1;
Protect[Power];

Off[General::spell1];

Coef[_, _, _, _?Negative] = 0;
Coef[p_, i_, n_, j_] := 
        Coefficient[p[[i]], n, j];

\(\(DegPoly[eqn_, a_[n_]] := 
        Module[{min, max, r, d, b, m, degreePoly, polyCoeffs, deltaCoeffs, i, 
            j, k, eq, lhs, rhs}, 

 (*\ 
            getting\ the\ coeffs\ *) 

eq = Numerator[Together[
                If[Head[eqn] === Equal, eqn[\([1]\)] - eqn[\([2]\)], 
                  eqn]]]; 
{min, 
              max} = \({Min[#], 
                  Max[#]} &\)@\((First /@ Cases[{eq}, a[_], Infinity] /. 
                  n -> 0)\); 
r = 
            max - min; \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ eq = 
            Collect[Expand[eq /. n -> n - min], 
              Table[a[n + i], {i, 0, r}]]; 
rhs = \(-Select[
                eq, FreeQ[#, a] &]\); 
lhs = 
            eq + rhs; \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ polyCoeffs = \(Coefficient[lhs, #] &\) /@ 
              Table[a[n + i], {i, 0, r}]; 
m = 
            Max[\(Exponent[#, n] &\) /@ 
                polyCoeffs]; 
deltaCoeffs = 
            Table[Expand[
                Sum[Binomial[k, j] polyCoeffs[\([k + 1]\)], {k, j, r}]], {j, 
                0, r}]; 
d = 
            Max[Map[Exponent[#, n] &, deltaCoeffs]]; 
b = 
            Max[MapIndexed[Exponent[#1, n] - #2[\([1]\)] + 1 &, 
                deltaCoeffs]]; 
Print["d = ", 
            d]; 
Print["b = ", 
            b]; 

 (*\ \([Pet92]\)\ *) 

For[degreePoly = 0; \ s = 0, 
            degreePoly === 0, \(s++\), 
            degreePoly = 
              Module[{i, j}, 
                Factor[Sum[
                    Binomial[x, j]\ Sum[
                        i^j\ Coef[polyCoeffs, i + 1, n, m - s + j], {i, 0, 
                          r}], {j, 0, 
                      s}]]]]; 
Print["s = ", 
            s - 1]; 
Print["D(x) = ", 
            degreePoly]; 

 (*\ \([Abr89]\), \ A = B\ *) 

degreePoly = 
            Factor[Sum[
                Coef[deltaCoeffs, k + 1, n, b + k] Binomial[x, k] \(k!\), {k, 
                  0, r}]]; 
Print["A(x) = ", 
            degreePoly]; 

 (*\ \([ABP95]\)\ *) 

degreePoly = 
            Factor[Sum[
                Coef[deltaCoeffs, k + 1, n, m] Binomial[x + b, j] 
                  Binomial[j, b + k] \(j!\) StirlingS2[m, j], {k, 0, r}, {j, 
                  0, d}, {m, j, d}]]; 
Print["B(x) = ", 
            degreePoly];
];\)
\)
On[General::spell1];

(1a)

DegPoly[n^2 y[n + 1] - n^2 y[n] == 0, y[n]]

DegPoly[n^5 y[n + 1] - n^5 y[n] == 0, y[n]]

(1b)

DegPoly[y[n + 2] - 2  y[n + 1] + y[n] == 0, y[n]]

DegPoly[n y[n + 2] - 2  n y[n + 1] + n y[n] == 0, 
      y[n]]

DegPoly[n^2 y[n + 2] - 2  n^2 y[n + 1] + n^2 y[n] == 0, 
      y[n]]

DegPoly[n^5 y[n + 2] - 2  n^5 y[n + 1] + n^5  y[n] == 0, 
      y[n]]

(1b')

DegPoly[y[n + 2] - 2 y[n + 1] + (1 + 1) y[n] == n + 1, 
      y[n]]

DegPoly[
      n y[n + 2] - 2  n y[n + 1] + (n + 1) y[n] == n + 1, 
      y[n]]

DegPoly[
      n^2 y[n + 2] - 2  n^2 y[n + 1] + (n^2 + 1) y[n] == n + 1, 
      y[n]]

DegPoly[
      n^3 y[n + 2] - 2  n^3 y[n + 1] + (n^3 + 1) y[n] == n + 1, 
      y[n]]

DegPoly[
      n^5 y[n + 2] - 2  n^5 y[n + 1] + (n^5 + 1) y[n] == n + 1, 
      y[n]]

(1c)

DegPoly[
      n^3  y[n + 3] - 3  n^3  y[n + 2] + 
          3  n^3  y[n + 1] - (n^3 + m ) y[n] == 0, 
      y[n]]

DegPoly[
      n^4  y[n + 3] - 3  n^4  y[n + 2] + 
          3  n^4  y[n + 1] - (n^4 + m n) y[n] == 0, 
      y[n]]

DegPoly[
      n^5  y[n + 3] - 3  n^5  y[n + 2] + 
          3  n^5  y[n + 1] - (n^5 + m n^2) y[n] == 0, 
      y[n]]

DegPoly[
      n^7  y[n + 3] - 3  n^7  y[n + 2] + 
          3  n^7  y[n + 1] - (n^7 + m n^4) y[n] == 0, 
      y[n]]

(2)

DegPoly[y[n + 1] -  y[n] == 0, y[n]]

DegPoly[y[n + 2] - 2  y[n + 1] + y[n] == 0, y[n]]

DegPoly[y[n + 3] - 3  y[n + 2] + 3  y[n + 1] - y[n] == 0, 
      y[n]]

DegPoly[
      y[n + 4] - 4  y[n + 3] + 6  y[n + 2] - 4  y[n + 1] + y[n] == 0, 
      y[n]]

(3)

DegPoly[(n^3 - 5) y[n + 2] + (-2 n^3 - 5  n^2 + 13) 
            y[n + 1] + (n^3 + 5  n^2 + 9  n + 1) y[n] == 0, 
      y[n]]

(4)

DeltaEq[m_] := 
      Sum[(-1)^(m - i) Binomial[m, i] y[n + i], {i, 0, 
          m}]

DegPoly[n^5 DeltaEq[3] + DeltaEq[4] == 0, y[n]]

DegPoly[n DeltaEq[7] + DeltaEq[4] == 0, y[n]]