Code to Expand Symmetric Laurent Polynomial in Symmetric Basis

Question

Let $F(w,y)$ be a symmetric Laurent polynomial. By this I mean the powers of $w,y$ are bounded above and below, and $F$ is invariant under $y \to y^{-1}, w \to w^{-1}$. Given such an $F$, there are uniquely determined integers $n_{g,h}$ such that

$$F(w,y) = \sum_{g,h \geq 0} n_{g,h} (y-2+y^{-1})^{g}(-w+2-w^{-1})^{h}.$$

This is effectively writing $F$ in a different basis. I'm hoping someone could help me with a code such that $F$ is the input, and it spits out the $n_{g,h}$. Here's those simple component polynomials in $w$ and $y$, respectively

fw[w_] := (2 - 1/w - w); fy[y_] := (-2 + 1/y + y);

And just for an example, here's a particular symmetric Laurent polynomial

F[w_, y_] := 4320 + 16/w^4 - 288/w^3 + 1408/w^2 - 3296/w - 3296 w + 1408 w^2 - 288 w^3 + 16 w^4 + 192/y + 32/(w^2 y) - 128/(w y) - (128 w)/y + (32 w^2)/y + 192 y + (32 y)/w^2 - (128 y)/w - 128 w y + 32 w^2 y

When I'm doing this by hand, you have to start with the highest powers of $F$ and start peeling away these factors of $y-2+y^{-1}$ and $-w+2-w^{-1}$. It's a bit tedious, and I feel like a program could handle this pretty easily, if I had more coding experience.

Answer 1

This readily translates into a polynomial algebra problem of canonical rewriting. GroebnerBasis and PolynomialReduce are good tools for this purpose.

Start by rewriting your Laurent polynomial as a standard one, by replacing negative powers with "reciprocal" variables, e.g. 1/y becomes yr.

lpoly = 4320 + 16/w^4 - 288/w^3 + 1408/w^2 - 3296/w - 3296 w + 
   1408 w^2 - 288 w^3 + 16 w^4 + 192/y + 32/(w^2 y) - 
   128/(w y) - (128 w)/y + (32 w^2)/y + 
   192 y + (32 y)/w^2 - (128 y)/w - 128 w y + 32 w^2 y;
{num, den} = NumeratorDenominator[Together[lpoly]];
newpoly = num (den /. {y -> yr, w -> wr});

We enforce the reciprocal nature of these new variables with polynomial relations such as y*yr-1. We also need polynomials denoting the desired replacements, that is, creating new variables to substitute for e.g. y+yr-2.

replacements = {p1 -> (w + wr - 2), p2 -> (y + yr - 2)};
redpolys = 
  Join[Apply[Subtract, replacements, {1}], {w*wr - 1, y*yr - 1}];
vars = {wr, yr, w, y, p1, p2};

Notice that these variables are ordered so that the new p1, p2 are lower (appear later) than the rest. This means our replacement statagem will favor a result in terms of these new variables.

In order to make sure we get a full rewrite we now create a Groebner basis from the reduction polynomials redpolys.

gb = GroebnerBasis[redpolys, vars];

Now do the reduction.

reduced = PolynomialReduce[newpoly, gb, vars][[2]]

(* Out[63]= 64 p1^2 - 160 p1^3 + 16 p1^4 + 32 p1^2 p2 *)

This gives a "full" rewrite, that is, a result only in terms of {p1, p2}. Now back-substitute:

reduced /. replacements

(* Out[64]= 64 (-2 + w + wr)^2 - 160 (-2 + w + wr)^3 + 16 (-2 + w + wr)^4 + 32 (-2 + w + wr)^2 (-2 + y + yr) *)

I illustrated on the provided example but the method is quite general and straightforward to code as a module.

Answer 2

Here is how I would solve this:

Given:

F[w_, y_] := 
 4320 + 16/w^4 - 288/w^3 + 1408/w^2 - 3296/w - 3296 w + 1408 w^2 - 
  288 w^3 + 16 w^4 + 192/y + 32/(w^2 y) - 
  128/(w y) - (128 w)/y + (32 w^2)/y + 
  192 y + (32 y)/w^2 - (128 y)/w - 128 w y + 32 w^2 y
fw[w_] := (2 - 1/w - w); 
fy[y_] := (-2 + 1/y + y);

Now consider the highest positive combined exponent. This is 4 in w^4. Therefore this term can only come from fw[w]^4. And n4,0 must be 16. Therefore we may subtract 16 fw[w]^4 from F[w,x]:

F[w, y] - (16 fw[w]^4 ) // Expand
(*3200 - 160/w^3 + 960/w^2 - 2400/w - 2400 w + 960 w^2 - 
 160 w^3 + 192/y + 32/(w^2 y) - 128/(w y) - (128 w)/y + (32 w^2)/y + 
 192 y + (32 y)/w^2 - (128 y)/w - 128 w y + 32 w^2 y*)

Now we repeat looking for the highest combined exponents. This time we have two candidates: 32 w^2 y and -160 w^3. The former can only com from fw[w]^2 fy[y] and n2,1=32. The latter from fw[w]^3 and n3,0=160.( Note the minus, is already contained in fw[w]^3) . Therefore, we subtract: 32 fw[w]^2 fy[y] + 160 fw[w]^3

F[w, y] - (16 fw[w]^4 + 32 fw[w]^2 fy[y] + 160 fw[w]^3) // Expand
(*384 + 64/w^2 - 256/w - 256 w + 64 w^2*)

Repeating, 2 is the highest exponent in 64 fw[w]^2, and we subtract this:

F[w, y] - (16 fw[w]^4 + 32 fw[w]^2 fy[y] + 160 fw[w]^3 + 
    64 fw[w]^2) // Expand
(*0*)

Therefore F[w,x] can be written as:

F[w, y] == 
  16 fw[w]^4 + 160 fw[w]^3 + 32 fw[w]^2 fy[y] + 64 fw[w]^2 // Simplify
(*True*)

Of course, this can be automated by MMA, but I leave this for an exercise for you.