Computation of the Hilbert series of  invariants of a generic circle representation

Emily Cowie (l.emily.cowie@gmail.com), Hans-Christian Herbig (herbig@imf.au.dk), Daniel Herden (daniel_herden@baylor.edu), Christopher Seaton (seatonc@rhodes.edu) 
May 15, 2015

This notebook takes as input two parts of a weight vector, a = {(Subscript[a, 1]), (Subscript[a, 2]), . . . , (Subscript[a, k])} (the negative weights, entered as positive integers) and b = {(Subscript[b, k+1]), (Subscript[b, k+2]), . . . , (Subscript[b, n])} (the positive weights) of a unitary representation of the circle on an n-dimensional vector space and outputs the Hilbert Series of the ring of invariant functions. The entries of a must be distinct. See Section 4 of https://www.sciencedirect.com/science/article/pii/S0022404918300768 ( arXiv:1707.03128v1 [math.RA] ).

To use this notebook, evaluate the definition of the three functions newFactor, manipPoly, and shiftSeries.  Change the definition of the weight vectors a, b as required and evaluate the last commands.

The function newFactor takes a polynomial p = poly in the variable z as input and factors out all factors of the form (1 - z^k) for positive integer k.  The output is a list with two entries; the first entry is a list indicating how many factors occur at each degree (e.g. {0, 1, 0, 2} corresponds to (1 - z)(1 - z^3)^2) and the second entry is the remaining factor of p which is not divisible by any (1 - z^k).

newFactor[p_]:=Module[{poly=p,k, polyFact},
(* Set up a blank table to record the factors. *)
polyFact=Table[0,{i,1, Exponent[poly,z]}];
(* set k = degree of the input polynomial.  We will search for factors starting with the highest possible degree k. *)
k=Exponent[poly,z];
While[k≥1,
(* If 1-z^k divides the polynomial, divide out this factor from poly, record this in the table polyFact, and check again. If not (or if the statement depends on the value of z, i.e. Mathematica interprets it as neither true nor false), increment k down. *)
If[PolynomialRemainder[poly, 1-z^k, z]==0,
polyFact[[k]]++;
poly=PolynomialQuotient[poly,1-z^k,z],
k=k-1,
k=k-1];];
(* Remove 0's at the end of the table polyFact. *)
k=Length[polyFact];
While[polyFact[[k]]==0,polyFact=Delete[polyFact,k];k=k-1;];
{polyFact,poly}]

The function manipPoly takes a list p = poly representing a product of factors of the form (1 - z^k) for positive integer k (identical to the first element of the output of newFactor, e.g. {0, 1, 0, 2} corresponds to (1 - z)(1 - z^3)^2) as well as a positive integer weight w = weight.  The output is a list with two entries; the first entry is a list indicating how many factors occur at each degree (e.g. {0, 1, 0, 2} corresponds to (1 - z)(1 - z^3)^2) and the second entry is the remaining factor of p which is not divisible by any (1 - z^k).  It changes each factor (1 - z^k) to (-1)^(gcd(k,w)+1)(1-z^(lcm (k,w)/w)^gcd(k,w).  The output is the resulting polynomial.

manipPoly[p_,weight_]:=Module[{poly=p,w=weight,sign,k,manPolyList,manPoly},
(* Set up a blank table manPolyList to record the factors of the new polynomial. *)
manPolyList=Table[0,{i,1,Length[poly]}];
(* As k changes from 1 to the highest degree of factors in poly, set the kth entry in manPolyList to be that of poly if gcd(k,w)=1 (no changes to the factors in this case).  If gcd(k,w) ≠ 1, then record the sign change (if any) and the new factor in manPolyList. *)
k=1;
While[k≤Length[poly],
If[GCD[k,w]==1,manPolyList[[k]]=manPolyList[[k]]+poly[[k]],
manPolyList[[LCM[w,k]/w]]=manPolyList[[LCM[w,k]/w]]+poly[[k]]*GCD[k,w];
];
k++];
(* Multiply the factors in manPolyList together to return a polynomial expression manPoly. *)
k=1;
manPoly=Product[(1-z^i)^manPolyList[[i]],{i,1,Length[manPolyList]}];
manPoly]

The function shiftSeries takes a rational function r = rat in z and a positive integer weight w = weight.  Letting D denote the degree of the denominator of rat, it computes the Maclaurin series of rat up to degree (D + 2)w.  It then shifts the series with weight a, i.e. replaces the series ∑(Subscript[c, k])(x^k) with the series ∑(Subscript[c, wk])(x^k).  The output is the shifted series (now up to degree (D + 2)) as a polynomial.

shiftSeries[rat_,weight_]:=Module[{r=rat,w=weight,k,poly,series},
series=CoefficientList[Series[r, {z, 0,w*(2+Exponent[Denominator[r],z])}],z];
(* A blank list to keep track of shifted series data. *)
newSeries={};
k=1;
(* Record in newSeries the coefficients of the MacLaurin series of rat in degrees divisible by w. *)
While[k≤Length[series],
If[Divisible[k-1,w]==True,newSeries=Append[newSeries, series[[k]]]];
k++];
k=1;
(* Add the terms of the shifted series together in poly. *)
poly=0;
While[k≤(Exponent[Denominator[r],z]+2)&&k≤Length[newSeries],
poly=poly+newSeries[[k]]*z^(k-1);
k++];
poly]

After evaluating the three functions above, change the definitions of a and b below and evaluate these lines.

a={5};
b={1,2};
start=SessionTime[];
k=Length[a];
n=k+Length[b];
FTildeList={};
r=1;
While[r≤k,FTilde[z_]=Simplify[Cancel[1/(Product[(1-z^(a[[r]]-a[[j]])),{j,1,r-1}]*Product[(1-z^(a[[r]]-a[[j]])),{j,r+1,k}]*Product[(1-z^(a[[r]]+b[[j]])),{j,1,n-k}])
]];
FTildeNum[z_]=Numerator[FTilde[z]];
FTildeDen[z_]=Denominator[FTilde[z]];
FTShiftedDen[z_]=manipPoly[newFactor[FTildeDen[z]][[1]],a[[r]]]*newFactor[FTildeDen[z]][[2]];
FTShiftedNum[z_]=Normal[Series[shiftSeries[FTilde[z],a[[r]]]*FTShiftedDen[z],{z,0,Exponent[FTShiftedDen[z],z]}]];
FTildeList=Append[FTildeList,FTildeNew[z_]=FTShiftedNum[z]/FTShiftedDen[z]];
r++];
hilbSer=Sum[FTildeList[[i]],{i,1,k}];
Print[-a,",",b];
Print["Hilbert Series: ",FullSimplify[Together[hilbSer]]];
Print["Laurent Series: ",Series[hilbSer,{z,1,8-2n}]];
fin=SessionTime[];
Print["The duration of this evaluation was ",fin-start," seconds."]