File for demonstrating square - integrability of certain residues of Eisenstein series

Stephen D. Miller
Rutgers University

February 2012

Residues for E6 series

Initialization

This loads in files defining the Root system.  The file allknown contains the Weyl group elements.

<<"D:\\Documents\\Green Eisenstein\\E6_tables_and_precomputation";Get["D:\\Documents\\Projects\\Exceptional Matrix Groups\\e6minlie"];

This defines the fundamental weights, and ρ

{ω1,ω2,ω3,ω4,ω5,ω6}=Inverse[Transpose[simproots]];fundweights={ω1,ω2,ω3,ω4,ω5,ω6};ρ=Total[Inverse[Transpose[simproots]]];

This defines a generic element of the Cartan Lie algebra.  The parametrization is not important.

ctnelt=t1 α1+t2 α2 +t3 α3+t4 α4+t5 α5+t6 α6;

This defines a general linear functional on an element of the Cartan Lie algebra.

genλ[{s1_,s2_,s3_,s4_,s5_,s6_},elt_]=(s1 ω1+s2 ω2+s3 ω3+s4 ω4+s5 ω5+s6 ω6).elt;

This defines (e^((ρ+wλ)H))on an element H of the Cartan Lie algebra.

charonctntblfnmat[mat_]:=Exp[Collect[(ρ+mat.(s1 ω1+s2 ω2+s3 ω3+s4 ω4+s5 ω5+s6 ω6)).ctnelt,{t1,t2,t3,t4,t5,t6}]];

These are used in defining the intertwining operators for each element of the Weyl group.

posroots=e6minlie[[2]].simproots;diff=Table[2genλ[{s1,s2,s3,s4,s5,s6},psr]/Norm[psr]^2,{psr,posroots}]//Simplify;

These are the basepoints that are suggested by Arthur' s list :

basepoints={{-1,-1,1,0,1,-1},{-1,0,-1,2,-1,-1},{-1,-1,-1,2,-1,-1},{-1,-1,-1,-1,3,0},{3,-1,-1,-1,-1,3},{-1,4,-1,-1,-1,-1},{5,-1,-1,-1,-1,-1},{2,-1,-1,-1,-1,-1},{-1,-1,-1,-1,-1,-1}};

Elimination of Weyl group elements

One must first select a weight.  Then a perturbation is defined in terms of the roots who do not take value - 1 (this is to eliminate many terms).

weightthatdefinesλ=basepoints[[1]]

weightthatdefinesλ={-1,0,-1,-1,-1,2}

weightthatdefinesperturb=Table[If[weightthatdefinesλ[[k]]==-1,0,1],{k,Length[weightthatdefinesλ]}]

We convert these to elements of the root system.

λtostudy=weightthatdefinesλ.Inverse[Transpose[simproots]];perturbdirection=weightthatdefinesperturb.Inverse[Transpose[simproots]];

This removes most elements of the Weyl group by discarding elements such that the intertwining operator vanishes on λ (using the - 1' s).

screenflip[mat_]:=(Length[Flatten[Position[Positive[ρ.(mat.Transpose[simproots[[Flatten[Position[weightthatdefinesλ,-1]]]]])],False]]]>0);relevantweylgroup=Select[allknown,screenflip[#]==False&];Print["Only ",Length[relevantweylgroup]," elements of the Weyl group are relevant."];

This computes the Weyl orbit of λ and its stabilizer.  It works with the relevantweylgroup.  For each element in the orbit, we keep track of the position in relevantweylgroup of the elements that map λ to it.  It makes two passes through the relevantweylgroup.

relevantweyltranslates=Table[Simplify[relevantweylgroup[[k]].λtostudy],{k,Length[relevantweylgroup]}];relevantorbit=Union[relevantweyltranslates];relevantorbitsize=Length[relevantorbit];relevantorbitbyposition=(relevantweyltranslates/.Table[relevantorbit[[k]]->k,{k,relevantorbitsize}]);orbitpos=Table[Flatten[Position[relevantorbitbyposition,k]],{k,relevantorbitsize}];

Next we compute which elements of the orbit already satisfy Langlands' square-integrability condition, and which do not (hence requiring further calculation to show that their have zero total contribution to the constant term).

alreadybounded=Select[Range[Length[orbitpos]],Max[fundweights.relevantorbit[[#]]]<0&];notalreadybounded=Complement[Range[relevantorbitsize],alreadybounded];wall=Select[Range[Length[orbitpos]],Max[fundweights.relevantorbit[[#]]]==0&];nonwall=Complement[notalreadybounded,wall];Print[Length[alreadybounded], " of the ",relevantorbitsize," relevant orbit terms are in bounded regime."];
Print[Length[notalreadybounded]," are in the unbounded regime.  Of those, ",Length[wall]," lie on the wall."];

We use the following in computing the intertwining operators, with information specific to λ and the perturbation above.

perturbedμtostudy=Solve[s1 ω1+s2 ω2+s3 ω3+s4 ω4+s5 ω5+s6 ω6==λtostudy+ϵ perturbdirection,{s1,s2,s3,s4,s5,s6}][[1]];inputtocs=(diff/.perturbedμtostudy//Simplify);

This is broken up into a constant term, and a term which is linear in ϵ.

inputtocs1=Coefficient[inputtocs,ϵ];inputtocs0=(inputtocs/.ϵ->0);

The intertwining operator is computed differently for each positive root (an integer from 1 to Length[posroots]).  cm1(s+1) is the name given to c(s)/(s+1), while cp1(s-1) is the name given to c(s)(s-1) = (s-1)/c(-s) = -1/cm1(-s).  The last 3 commands factor intopfnmat[mat]Exp[ϵ (mat.perturbdirection).ctnelt], which is the summand in the constant term formula, as a rational number, power of epsilon, and exponential.

intertwin[root_]:=If[inputtocs0[[root]]==-1,ϵ inputtocs1[[root]] cm1[ϵ inputtocs1[[root]]],If[inputtocs0[[root]]==1,cp1[ϵ inputtocs1[[root]]]/(ϵ inputtocs1[[root]] ),c[inputtocs[[root]]]]];intopfnmat[mat_]:=Block[{k3,invlist},invlist=Flatten[Position[Positive[ρ.(mat.Transpose[posroots])],False]];Product[intertwin[invlist[[k3]]],{k3,Length[invlist]}]];orderofϵ[mat_]:=Block[{invlist,inputtocsoninvlist},invlist=Flatten[Position[Positive[ρ.(mat.Transpose[posroots])],False]];inputtocsoninvlist=inputtocs0[[invlist]];Count[inputtocsoninvlist,-1]-Count[inputtocsoninvlist,1]];outsideconstant[mat_]:=(ϵ^(-orderofϵ[mat])intopfnmat[mat]/.E->1);exponent[mat_]:=Part[Simplify[intopfnmat[mat]Exp[ϵ(mat.perturbdirection).ctnelt] ϵ^(-orderofϵ[mat])/outsideconstant[mat]],2]

We now check that these commands give the right answers, by going through the expressions they give for each relevant Weyl group element.

Union[ParallelTable[Print[Position[relevantweylgroup,mat]];intopfnmat[mat]Exp[ϵ(mat.perturbdirection).ctnelt] ==outsideconstant[mat] Exp[exponent[mat]]ϵ^orderofϵ[mat]//Simplify,{mat,relevantweylgroup}]]

c[z_]=-Exp[cl[z]-cl[-z]];cm1[z_]=Exp[cm1log[z]];cp1[z_]=-Exp[-cm1log[-z]];

To figure out the power series of the already bounded terms

Finding the order for each relevant Weyl group orbit

Setting up the common orders

We seem to always find that commonorderofϵ is constant on each one.  This checks that assertion.

commonorderofϵalreadybounded=Table[Union[Table[orderofϵ[mat],{mat,relevantweylgroup[[orbitpos[[alreadybounded[[co1]]]]]]}]],{co1,Length[alreadybounded]}]

commonorderofϵnotalreadybounded=Table[Union[Table[orderofϵ[mat],{mat,relevantweylgroup[[orbitpos[[notalreadybounded[[co1]]]]]]}]],{co1,Length[notalreadybounded]}]

commonorderofϵnonwall=Table[Union[Table[orderofϵ[mat],{mat,relevantweylgroup[[orbitpos[[nonwall[[co1]]]]]]}]],{co1,Length[nonwall]}]

commonorderofϵwall=Table[Union[Table[orderofϵ[mat],{mat,relevantweylgroup[[orbitpos[[wall[[co1]]]]]]}]],{co1,Length[wall]}]

Union[Length/@Join[commonorderofϵalreadybounded,commonorderofϵnotalreadybounded]]=={1}

This part is for the alreadybounded analysis

powertocheckto=15;exptemplate=Series[Exp[Sum[ToExpression["c"<>ToString[k]]ϵ^(k),{k,1,powertocheckto}]],{ϵ,0,powertocheckto}];

This makes a table of the exponents, outside constants, and the common order of ϵ for all relevant Weyl group elements that map to a particular already bounded orbit point.

This then looks at the higher coefficients (corresponding to ϵ^(commonorderofϵ + a nonnegative number called "power" here)).  It is supposed to show vanishing up to the order vanishingofalreadyboundedpartuntil.

vanishingofalreadyboundedpartuntil=1;

Table[coeflist=Table[tmp=exponent[mat];tmp2=CoefficientList[Series[tmp,{ϵ,0,powertocheckto}],ϵ];While[Length[tmp2]<powertocheckto+1,AppendTo[tmp2,0]];If[Total[tmp2]≠Normal[tmp],Print["coeflist formation violation"]];tmp2,{mat,relevantweylgroup[[orbitpos[[alreadybounded[[co1]]]]]]}];outsidelist=Table[outsideconstant[mat],{mat,relevantweylgroup[[orbitpos[[alreadybounded[[co1]]]]]]}];commonorderofϵ=commonorderofϵalreadybounded[[co1]];Table[testerlist=Expand[Simplify[SeriesCoefficient[exptemplate,{ϵ,0,power}]]];If[power==0,testerlist={1}];If[power==1,testerlist={c1}];If[testerlist≠Total[testerlist],Print["testerlist failure"]];Table[Print[{co1,Length[alreadybounded],power,vanishingofalreadyboundedpartuntil-commonorderofϵ[[1]],co,Length[testerlist]}];tester=testerlist[[co]];ParallelSum[If[Mod[k,50]==0,Print[{k,Length[outsidelist]}]];(tester/.c1->coeflist[[k,2]]/.c2->coeflist[[k,3]]/.c3->coeflist[[k,4]]/.c4->coeflist[[k,5]]/.c5->coeflist[[k,6]]/.c6->coeflist[[k,7]]/.c7->coeflist[[k,8]]/.c8->coeflist[[k,9]]/.c9->coeflist[[k,10]]/.c10->coeflist[[k,11]]/.c11->coeflist[[k,12]]/.c12->coeflist[[k,13]]/.c13->coeflist[[k,14]]/.c14->coeflist[[k,15]]/.c15->coeflist[[k,16]])outsidelist[[k]]//Expand,{k,Length[outsidelist]}],{co,1, Length[testerlist]}],{power,0,vanishingofalreadyboundedpartuntil-commonorderofϵ[[1]]}],{co1,1,Length[alreadybounded]}]

Flatten[%]//Union

We need at least one of these to not vanish to the next order :

Table[coeflist=Table[tmp=exponent[mat];tmp2=CoefficientList[Series[tmp,{ϵ,0,powertocheckto}],ϵ];While[Length[tmp2]<powertocheckto+1,AppendTo[tmp2,0]];If[Total[tmp2]≠Normal[tmp],Print["coeflist formation violation"]];tmp2,{mat,relevantweylgroup[[orbitpos[[alreadybounded[[co1]]]]]]}];outsidelist=Table[outsideconstant[mat],{mat,relevantweylgroup[[orbitpos[[alreadybounded[[co1]]]]]]}];commonorderofϵ=commonorderofϵalreadybounded[[co1]];Table[testerlist=Expand[Simplify[SeriesCoefficient[exptemplate,{ϵ,0,power}]]];If[power==0,testerlist={1}];If[power==1,testerlist={c1}];If[testerlist≠Total[testerlist],Print["testerlist failure"]];Table[Print[{co1,power,co,Length[testerlist]}];tester=testerlist[[co]];ParallelSum[If[Mod[k,50]==0,Print[k]];(tester/.c1->coeflist[[k,2]]/.c2->coeflist[[k,3]]/.c3->coeflist[[k,4]]/.c4->coeflist[[k,5]]/.c5->coeflist[[k,6]]/.c6->coeflist[[k,7]]/.c7->coeflist[[k,8]]/.c8->coeflist[[k,9]]/.c9->coeflist[[k,10]]/.c10->coeflist[[k,11]]/.c11->coeflist[[k,12]]/.c12->coeflist[[k,13]]/.c13->coeflist[[k,14]]/.c14->coeflist[[k,15]]/.c15->coeflist[[k,16]])outsidelist[[k]]//Expand,{k,Length[outsidelist]}],{co,1, Length[testerlist]}],{power,vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]],vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]]}],{co1,(* 1*) 1,Length[alreadybounded](*Length[alreadybounded]*)}]

Coefficient[%[[1,1]],(t2^4) (t3^2)]

This part is for the notalreadybounded-nonwall analysis

powertocheckto=15;exptemplate=Series[Exp[Sum[ToExpression["c"<>ToString[k]]ϵ^(k),{k,1,powertocheckto}]],{ϵ,0,powertocheckto}];

This does a similar analysis for the orbits off the wall, and shows they vanish to a higher order than the already bounded ones.

Table[coeflist=Table[tmp=exponent[mat];tmp2=CoefficientList[Series[tmp,{ϵ,0,powertocheckto}],ϵ];While[Length[tmp2]<powertocheckto+1,AppendTo[tmp2,0]];If[Total[tmp2]≠Normal[tmp],Print["coeflist formation violation"]];tmp2,{mat,relevantweylgroup[[orbitpos[[nonwall[[co1]]]]]]}];outsidelist=Table[outsideconstant[mat],{mat,relevantweylgroup[[orbitpos[[nonwall[[co1]]]]]]}];commonorderofϵ=commonorderofϵnonwall[[co1]];Table[testerlist=Expand[Simplify[SeriesCoefficient[exptemplate,{ϵ,0,power}]]];If[power==0,testerlist={1}];If[power==1,testerlist={c1}];If[testerlist≠Total[testerlist],Print["testerlist failure"]];Table[Print[{co1,Length[nonwall],power,vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]],co,Length[testerlist]}];tester=testerlist[[co]];ParallelSum[If[Mod[k,50]==0,Print[k]];(tester/.c1->coeflist[[k,2]]/.c2->coeflist[[k,3]]/.c3->coeflist[[k,4]]/.c4->coeflist[[k,5]]/.c5->coeflist[[k,6]]/.c6->coeflist[[k,7]]/.c7->coeflist[[k,8]]/.c8->coeflist[[k,9]]/.c9->coeflist[[k,10]]/.c10->coeflist[[k,11]]/.c11->coeflist[[k,12]]/.c12->coeflist[[k,13]]/.c13->coeflist[[k,14]]/.c14->coeflist[[k,15]]/.c15->coeflist[[k,16]])outsidelist[[k]]//Expand,{k,Length[outsidelist]}],{co,1, Length[testerlist]}],{power,0,vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]]}],{co1,1,Length[nonwall]}]

Flatten[%]//Union

This part is for the notalreadybounded - wall analysis

This first checks that the wall terms vanish to at least the same order as the already bounded ones.

Table[coeflist=Table[tmp=exponent[mat];tmp2=CoefficientList[Series[tmp,{ϵ,0,powertocheckto}],ϵ];While[Length[tmp2]<powertocheckto+1,AppendTo[tmp2,0]];If[Total[tmp2]≠Normal[tmp],Print["coeflist formation violation"]];tmp2,{mat,relevantweylgroup[[orbitpos[[wall[[co1]]]]]]}];outsidelist=Table[outsideconstant[mat],{mat,relevantweylgroup[[orbitpos[[wall[[co1]]]]]]}];commonorderofϵ=commonorderofϵwall[[co1]];Table[testerlist=Expand[Simplify[SeriesCoefficient[exptemplate,{ϵ,0,power}]]];If[power==0,testerlist={1}];If[power==1,testerlist={c1}];If[testerlist≠Total[testerlist],Print["testerlist failure"]];Table[Print[{co1,Length[wall],power,vanishingofalreadyboundedpartuntil-commonorderofϵ[[1]],co,Length[testerlist]}];tester=testerlist[[co]];ParallelSum[If[Mod[k,50]==0,Print[k]];(tester/.c1->coeflist[[k,2]]/.c2->coeflist[[k,3]]/.c3->coeflist[[k,4]]/.c4->coeflist[[k,5]]/.c5->coeflist[[k,6]]/.c6->coeflist[[k,7]]/.c7->coeflist[[k,8]]/.c8->coeflist[[k,9]]/.c9->coeflist[[k,10]]/.c10->coeflist[[k,11]]/.c11->coeflist[[k,12]]/.c12->coeflist[[k,13]]/.c13->coeflist[[k,14]]/.c14->coeflist[[k,15]]/.c15->coeflist[[k,16]])outsidelist[[k]]//Expand,{k,Length[outsidelist]}],{co,1, Length[testerlist]}],{power,0,vanishingofalreadyboundedpartuntil-commonorderofϵ[[1]]}],{co1,1,Length[wall]}]

Flatten[%]//Union

Next we see if this vanishing goes further:

Table[coeflist=Table[tmp=exponent[mat];tmp2=CoefficientList[Series[tmp,{ϵ,0,powertocheckto}],ϵ];While[Length[tmp2]<powertocheckto+1,AppendTo[tmp2,0]];If[Total[tmp2]≠Normal[tmp],Print["coeflist formation violation"]];tmp2,{mat,relevantweylgroup[[orbitpos[[wall[[co1]]]]]]}];outsidelist=Table[outsideconstant[mat],{mat,relevantweylgroup[[orbitpos[[wall[[co1]]]]]]}];commonorderofϵ=commonorderofϵwall[[co1]];Table[testerlist=Expand[Simplify[SeriesCoefficient[exptemplate,{ϵ,0,power}]]];If[power==0,testerlist={1}];If[power==1,testerlist={c1}];If[testerlist≠Total[testerlist],Print["testerlist failure"]];Table[Print[{co1,Length[wall],power,vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]],co,Length[testerlist]}];tester=testerlist[[co]];ParallelSum[If[Mod[k,50]==0,Print[k]];(tester/.c1->coeflist[[k,2]]/.c2->coeflist[[k,3]]/.c3->coeflist[[k,4]]/.c4->coeflist[[k,5]]/.c5->coeflist[[k,6]]/.c6->coeflist[[k,7]]/.c7->coeflist[[k,8]]/.c8->coeflist[[k,9]]/.c9->coeflist[[k,10]]/.c10->coeflist[[k,11]]/.c11->coeflist[[k,12]]/.c12->coeflist[[k,13]]/.c13->coeflist[[k,14]]/.c14->coeflist[[k,15]]/.c15->coeflist[[k,16]])outsidelist[[k]]//Expand,{k,Length[outsidelist]}],{co,1, Length[testerlist]}],{power,vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]],vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]]}],{co1,1,Length[wall]}]

Coefficient[%41[[3]], t1^3]

orbitpos[[wall[[1]]]]

relevantweylgroup[[orbitpos[[wall[[2]]]]]]

Table[%[[k]].λtostudy,{k,Length[%]}]//Union

%.Transpose[simproots]

λtostudy.Transpose[simproots]

Position[relevantweyltranslates,λtostudy]

Residues for E7 series

Initialization

This loads in files defining the Root system.  The file allknown contains the Weyl group elements.

<<"D:\\Documents\\Green Eisenstein\\E7_tables_and_precomputation";Get["D:\\Documents\\Projects\\Exceptional Matrix Groups\\e7minlie"];

This defines the fundamental weights, and ρ

{ω1,ω2,ω3,ω4,ω5,ω6,ω7}=Inverse[Transpose[simproots]];fundweights={ω1,ω2,ω3,ω4,ω5,ω6,ω7};ρ=Total[Inverse[Transpose[simproots]]];

This defines a generic element of the Cartan Lie algebra.  The parametrization is not important.

ctnelt=t1 α1+t2 α2 +t3 α3+t4 α4+t5 α5+t6 α6+t7 α7;

This defines a general linear functional on an element of the Cartan Lie algebra.

genλ[{s1_,s2_,s3_,s4_,s5_,s6_,s7_},elt_]=(s1 ω1+s2 ω2+s3 ω3+s4 ω4+s5 ω5+s6 ω6+s7 ω7).elt;

This defines (e^((ρ+wλ)H))on an element H of the Cartan Lie algebra.

charonctntblfnmat[mat_]:=Exp[Collect[(ρ+mat.(s1 ω1+s2 ω2+s3 ω3+s4 ω4+s5 ω5+s6 ω6+s7 ω7)).ctnelt,{t1,t2,t3,t4,t5,t6,t7}]];

These are used in defining the intertwining operators for each element of the Weyl group.

posroots=e7minlie[[2]].simproots;diff=Table[2genλ[{s1,s2,s3,s4,s5,s6,s7},psr]/Norm[psr]^2,{psr,posroots}]//Simplify;

These are the basepoints that are suggested by Arthur' s list :

basepoints={{0,-1,0,1,-1,1,-1},{1,-1,-1,1,0,0,-1},{0,-1,1,-1,2,-1,-1},{-1,-1,-1,2,-1,1,-1},{0,-1,0,2,-1,-1,-1},{-1,-1,-1,3,-1,-1,0},{3,-1,-1,-1,-1,3,0},{3,-1,-1,-1,2,-1,-1},{-1,-1,-1,3,-1,-1,-1},{0,-1,4,-1,-1,-1,-1},{-1,-1,-1,-1,4,-1,-1},{3,-1,-1,-1,-1,4,-1},{3,4,-1,-1,-1,-1,-1},{5,-1,-1,-1,-1,-1,4},{-1,-1,4,-1,-1,-1,-1},{-1,6,-1,-1,-1,-1,-1},{-1,5,-1,-1,-1,-1,-1},{-1,4,-1,-1,-1,-1,-1},{-1,-1,-1,-1,-1,-1,8},{7,-1,-1,-1,-1,-1,-1},{4,-1,-1,-1,-1,-1,-1},{2,-1,-1,-1,-1,-1,-1},{-1,-1,-1,-1,-1,-1,-1}};

Dimensions[basepoints]

Elimination of Weyl group elements

One must first select a weight.  Then a perturbation is defined in terms of the roots who do not take value - 1 (this is to eliminate many terms).

weightthatdefinesλ=basepoints[[1]]

weightthatdefinesperturb=Table[If[weightthatdefinesλ[[k]]==-1,0,1],{k,Length[weightthatdefinesλ]}]

We convert these to elements of the root system.

λtostudy=weightthatdefinesλ.Inverse[Transpose[simproots]];perturbdirection=weightthatdefinesperturb.Inverse[Transpose[simproots]];

This removes most elements of the Weyl group by discarding elements such that the intertwining operator vanishes on λ (using the - 1' s).

screenflip[mat_]:=(Length[Flatten[Position[Positive[ρ.(mat.Transpose[simproots[[Flatten[Position[weightthatdefinesλ,-1]]]]])],False]]]>0);allknown[{k4a_,k4b_}]:=E5Weylgroup[[k4a]].cosets67[[k4b]];relevantweylgroup={};relevantweylgroup={};Do[If[Mod[k4b,10]==0,Print[{k4b,1512}]];tmp=ParallelTable[screenflip[allknown[{k4a,k4b}]],{k4a,1920}];Do[AppendTo[relevantweylgroup,Simplify[allknown[{k4a,k4b}]]],{k4a,Flatten[Position[tmp,False]]}],{k4b,1,1512}]

Dimensions[relevantweylgroup]

k4b

Print["Only ",Length[relevantweylgroup]," elements of the Weyl group are relevant."];

This computes the Weyl orbit of λ and its stabilizer.  It works with the relevantweylgroup.  For each element in the orbit, we keep track of the position in relevantweylgroup of the elements that map λ to it.  It makes two passes through the relevantweylgroup.

relevantweyltranslates=Table[Simplify[relevantweylgroup[[k]].λtostudy],{k,Length[relevantweylgroup]}];relevantorbit=Union[relevantweyltranslates];relevantorbitsize=Length[relevantorbit];relevantorbitbyposition=(relevantweyltranslates/.Table[relevantorbit[[k]]->k,{k,relevantorbitsize}]);orbitpos=Table[Flatten[Position[relevantorbitbyposition,k]],{k,relevantorbitsize}];

Next we compute which elements of the orbit already satisfy Langlands' square-integrability condition, and which do not (hence requiring further calculation to show that their have zero total contribution to the constant term).

alreadybounded=Select[Range[Length[orbitpos]],Max[fundweights.relevantorbit[[#]]]<0&];notalreadybounded=Complement[Range[relevantorbitsize],alreadybounded];wall=Select[Range[Length[orbitpos]],Max[fundweights.relevantorbit[[#]]]==0&];nonwall=Complement[notalreadybounded,wall];Print[Length[alreadybounded], " of the ",relevantorbitsize," relevant orbit terms are in bounded regime."];
Print[Length[notalreadybounded]," are in the unbounded regime.  Of those, ",Length[wall]," lie on the wall."];

We use the following in computing the intertwining operators, with information specific to λ and the perturbation above.

perturbedμtostudy=Solve[s1 ω1+s2 ω2+s3 ω3+s4 ω4+s5 ω5+s6 ω6+s7 ω7==λtostudy+ϵ perturbdirection,{s1,s2,s3,s4,s5,s6,s7}][[1]];inputtocs=(diff/.perturbedμtostudy//Simplify);

This is broken up into a constant term, and a term which is linear in ϵ.

inputtocs1=Coefficient[inputtocs,ϵ];inputtocs0=(inputtocs/.ϵ->0);

The intertwining operator is computed differently for each positive root (an integer from 1 to Length[posroots]).  cm1(s+1) is the name given to c(s)/(s+1), while cp1(s-1) is the name given to c(s)(s-1) = (s-1)/c(-s) = -1/cm1(-s).  The last 3 commands factor intopfnmat[mat]Exp[ϵ (mat.perturbdirection).ctnelt], which is the summand in the constant term formula, as a rational number, power of epsilon, and exponential.

intertwin[root_]:=If[inputtocs0[[root]]==-1,ϵ inputtocs1[[root]] cm1[ϵ inputtocs1[[root]]],If[inputtocs0[[root]]==1,cp1[ϵ inputtocs1[[root]]]/(ϵ inputtocs1[[root]] ),c[inputtocs[[root]]]]];intopfnmat[mat_]:=Block[{k3,invlist},invlist=Flatten[Position[Positive[ρ.(mat.Transpose[posroots])],False]];Product[intertwin[invlist[[k3]]],{k3,Length[invlist]}]];orderofϵ[mat_]:=Block[{invlist,inputtocsoninvlist},invlist=Flatten[Position[Positive[ρ.(mat.Transpose[posroots])],False]];inputtocsoninvlist=inputtocs0[[invlist]];Count[inputtocsoninvlist,-1]-Count[inputtocsoninvlist,1]];outsideconstant[mat_]:=(ϵ^(-orderofϵ[mat])intopfnmat[mat]/.E->1);exponent[mat_]:=Part[Simplify[intopfnmat[mat]Exp[ϵ(mat.perturbdirection).ctnelt] ϵ^(-orderofϵ[mat])/outsideconstant[mat]],2]

We now check that these commands give the right answers, by going through the expressions they give for each relevant Weyl group element.

Union[ParallelTable[If[Mod[Position[relevantweylgroup,mat][[1,1]],100]==1,Print[Position[relevantweylgroup,mat][[1,1]]]];intopfnmat[mat]Exp[ϵ(mat.perturbdirection).ctnelt] ==outsideconstant[mat] Exp[exponent[mat]]ϵ^orderofϵ[mat]//Simplify,{mat,relevantweylgroup}]]

c[z_]=-Exp[cl[z]-cl[-z]];cm1[z_]=Exp[cm1log[z]];cp1[z_]=-Exp[-cm1log[-z]];

To figure out the power series of the already bounded terms

Finding the order for each relevant Weyl group orbit

Setting up the common orders

We seem to always find that commonorderofϵ is constant on each one.  This checks that assertion.

commonorderofϵalreadybounded=Table[Union[Table[orderofϵ[mat],{mat,relevantweylgroup[[orbitpos[[alreadybounded[[co1]]]]]]}]],{co1,Length[alreadybounded]}]

commonorderofϵnotalreadybounded=Table[Union[Table[orderofϵ[mat],{mat,relevantweylgroup[[orbitpos[[notalreadybounded[[co1]]]]]]}]],{co1,Length[notalreadybounded]}]

commonorderofϵnonwall=Table[Union[Table[orderofϵ[mat],{mat,relevantweylgroup[[orbitpos[[nonwall[[co1]]]]]]}]],{co1,Length[nonwall]}]

commonorderofϵwall=Table[Union[Table[orderofϵ[mat],{mat,relevantweylgroup[[orbitpos[[wall[[co1]]]]]]}]],{co1,Length[wall]}]

Union[Length/@Join[commonorderofϵalreadybounded,commonorderofϵnotalreadybounded]]=={1}

Min[Flatten[commonorderofϵalreadybounded]]

This part is for the alreadybounded analysis

powertocheckto=15;exptemplate=Series[Exp[Sum[ToExpression["c"<>ToString[k]]ϵ^(k),{k,1,powertocheckto}]],{ϵ,0,powertocheckto}];

This makes a table of the exponents, outside constants, and the common order of ϵ for all relevant Weyl group elements that map to a particular already bounded orbit point.

This then looks at the higher coefficients (corresponding to ϵ^(commonorderofϵ + a nonnegative number called "power" here)).  It is supposed to show vanishing up to the order vanishingofalreadyboundedpartuntil.

vanishingofalreadyboundedpartuntil=4;

Table[coeflist=Table[tmp=exponent[mat];tmp2=CoefficientList[Series[tmp,{ϵ,0,powertocheckto}],ϵ];While[Length[tmp2]<powertocheckto+1,AppendTo[tmp2,0]];If[Total[tmp2]≠Normal[tmp],Print["coeflist formation violation"]];tmp2,{mat,relevantweylgroup[[orbitpos[[alreadybounded[[co1]]]]]]}];outsidelist=Table[outsideconstant[mat],{mat,relevantweylgroup[[orbitpos[[alreadybounded[[co1]]]]]]}];commonorderofϵ=commonorderofϵalreadybounded[[co1]];Table[testerlist=Expand[Simplify[SeriesCoefficient[exptemplate,{ϵ,0,power}]]];If[power==0,testerlist={1}];If[power==1,testerlist={c1}];If[testerlist≠Total[testerlist],Print["testerlist failure"]];Table[Print[{co1,Length[alreadybounded],power,vanishingofalreadyboundedpartuntil-commonorderofϵ[[1]],co,Length[testerlist]}];tester=testerlist[[co]];ParallelSum[If[Mod[k,50]==0,Print[{k,Length[outsidelist]}]];(tester/.c1->coeflist[[k,2]]/.c2->coeflist[[k,3]]/.c3->coeflist[[k,4]]/.c4->coeflist[[k,5]]/.c5->coeflist[[k,6]]/.c6->coeflist[[k,7]]/.c7->coeflist[[k,8]]/.c8->coeflist[[k,9]]/.c9->coeflist[[k,10]]/.c10->coeflist[[k,11]]/.c11->coeflist[[k,12]]/.c12->coeflist[[k,13]]/.c13->coeflist[[k,14]]/.c14->coeflist[[k,15]]/.c15->coeflist[[k,16]])outsidelist[[k]]//Expand,{k,Length[outsidelist]}],{co,1, Length[testerlist]}],{power,0,vanishingofalreadyboundedpartuntil-commonorderofϵ[[1]]}],{co1,1,Length[alreadybounded]}]

Flatten[%]//Union

We need at least one of these to not vanish to the next order :

Table[coeflist=Table[tmp=exponent[mat];tmp2=CoefficientList[Series[tmp,{ϵ,0,powertocheckto}],ϵ];While[Length[tmp2]<powertocheckto+1,AppendTo[tmp2,0]];If[Total[tmp2]≠Normal[tmp],Print["coeflist formation violation"]];tmp2,{mat,relevantweylgroup[[orbitpos[[alreadybounded[[co1]]]]]]}];outsidelist=Table[outsideconstant[mat],{mat,relevantweylgroup[[orbitpos[[alreadybounded[[co1]]]]]]}];commonorderofϵ=commonorderofϵalreadybounded[[co1]];Table[If[power≥0,testerlist=Expand[Simplify[SeriesCoefficient[exptemplate,{ϵ,0,power}]]];If[power==0,testerlist={1}];If[power==1,testerlist={c1}];If[testerlist≠Total[testerlist],Print["testerlist failure"]];Table[Print[{co1,power,co,Length[testerlist]}];tester=testerlist[[co]];ParallelSum[If[Mod[k,50]==0,Print[k]];(tester/.c1->coeflist[[k,2]]/.c2->coeflist[[k,3]]/.c3->coeflist[[k,4]]/.c4->coeflist[[k,5]]/.c5->coeflist[[k,6]]/.c6->coeflist[[k,7]]/.c7->coeflist[[k,8]]/.c8->coeflist[[k,9]]/.c9->coeflist[[k,10]]/.c10->coeflist[[k,11]]/.c11->coeflist[[k,12]]/.c12->coeflist[[k,13]]/.c13->coeflist[[k,14]]/.c14->coeflist[[k,15]]/.c15->coeflist[[k,16]])outsidelist[[k]]//Expand,{k,Length[outsidelist]}],{co,1, Length[testerlist]}]],{power,vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]],vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]]}],{co1,(* 1*) 1,59(*Length[alreadybounded]*)}]

Coefficient[%[[1,1]],t2 t4 t6]

This part is for the notalreadybounded-nonwall analysis

powertocheckto=15;exptemplate=Series[Exp[Sum[ToExpression["c"<>ToString[k]]ϵ^(k),{k,1,powertocheckto}]],{ϵ,0,powertocheckto}];

This does a similar analysis for the orbits off the wall, and shows they vanish to a higher order than the already bounded ones.

Table[coeflist=Table[tmp=exponent[mat];tmp2=CoefficientList[Series[tmp,{ϵ,0,powertocheckto}],ϵ];While[Length[tmp2]<powertocheckto+1,AppendTo[tmp2,0]];If[Total[tmp2]≠Normal[tmp],Print["coeflist formation violation"]];tmp2,{mat,relevantweylgroup[[orbitpos[[nonwall[[co1]]]]]]}];outsidelist=Table[outsideconstant[mat],{mat,relevantweylgroup[[orbitpos[[nonwall[[co1]]]]]]}];commonorderofϵ=commonorderofϵnonwall[[co1]];Table[testerlist=Expand[Simplify[SeriesCoefficient[exptemplate,{ϵ,0,power}]]];If[power==0,testerlist={1}];If[power==1,testerlist={c1}];If[testerlist≠Total[testerlist],Print["testerlist failure"]];Table[Print[{co1,Length[nonwall],power,vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]],co,Length[testerlist]}];tester=testerlist[[co]];ParallelSum[If[Mod[k,50]==0,Print[k]];(tester/.c1->coeflist[[k,2]]/.c2->coeflist[[k,3]]/.c3->coeflist[[k,4]]/.c4->coeflist[[k,5]]/.c5->coeflist[[k,6]]/.c6->coeflist[[k,7]]/.c7->coeflist[[k,8]]/.c8->coeflist[[k,9]]/.c9->coeflist[[k,10]]/.c10->coeflist[[k,11]]/.c11->coeflist[[k,12]]/.c12->coeflist[[k,13]]/.c13->coeflist[[k,14]]/.c14->coeflist[[k,15]]/.c15->coeflist[[k,16]])outsidelist[[k]]//Expand,{k,Length[outsidelist]}],{co,1, Length[testerlist]}],{power,0,vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]]}],{co1,1,Length[nonwall]}]

Flatten[%]//Union

This part is for the notalreadybounded - wall analysis

This first checks that the wall terms vanish to at least the same order as the already bounded ones.

powertocheckto=15;exptemplate=Series[Exp[Sum[ToExpression["c"<>ToString[k]]ϵ^(k),{k,1,powertocheckto}]],{ϵ,0,powertocheckto}];

Table[coeflist=Table[tmp=exponent[mat];tmp2=CoefficientList[Series[tmp,{ϵ,0,powertocheckto}],ϵ];While[Length[tmp2]<powertocheckto+1,AppendTo[tmp2,0]];If[Total[tmp2]≠Normal[tmp],Print["coeflist formation violation"]];tmp2,{mat,relevantweylgroup[[orbitpos[[wall[[co1]]]]]]}];outsidelist=Table[outsideconstant[mat],{mat,relevantweylgroup[[orbitpos[[wall[[co1]]]]]]}];commonorderofϵ=commonorderofϵwall[[co1]];Table[testerlist=Expand[Simplify[SeriesCoefficient[exptemplate,{ϵ,0,power}]]];If[power==0,testerlist={1}];If[power==1,testerlist={c1}];If[testerlist≠Total[testerlist],Print["testerlist failure"]];Table[Print[{co1,Length[wall],power,vanishingofalreadyboundedpartuntil-commonorderofϵ[[1]],co,Length[testerlist]}];tester=testerlist[[co]];ParallelSum[If[Mod[k,50]==0,Print[k]];(tester/.c1->coeflist[[k,2]]/.c2->coeflist[[k,3]]/.c3->coeflist[[k,4]]/.c4->coeflist[[k,5]]/.c5->coeflist[[k,6]]/.c6->coeflist[[k,7]]/.c7->coeflist[[k,8]]/.c8->coeflist[[k,9]]/.c9->coeflist[[k,10]]/.c10->coeflist[[k,11]]/.c11->coeflist[[k,12]]/.c12->coeflist[[k,13]]/.c13->coeflist[[k,14]]/.c14->coeflist[[k,15]]/.c15->coeflist[[k,16]])outsidelist[[k]]//Expand,{k,Length[outsidelist]}],{co,1, Length[testerlist]}],{power,0,vanishingofalreadyboundedpartuntil-commonorderofϵ[[1]]}],{co1,1,Length[wall]}]

Flatten[%]//Union

Next we see if this vanishing goes further:

Table[coeflist=Table[tmp=exponent[mat];tmp2=CoefficientList[Series[tmp,{ϵ,0,powertocheckto}],ϵ];While[Length[tmp2]<powertocheckto+1,AppendTo[tmp2,0]];If[Total[tmp2]≠Normal[tmp],Print["coeflist formation violation"]];tmp2,{mat,relevantweylgroup[[orbitpos[[wall[[co1]]]]]]}];outsidelist=Table[outsideconstant[mat],{mat,relevantweylgroup[[orbitpos[[wall[[co1]]]]]]}];commonorderofϵ=commonorderofϵwall[[co1]];Table[If[power≥0,testerlist=Expand[Simplify[SeriesCoefficient[exptemplate,{ϵ,0,power}]]];If[power==0,testerlist={1}];If[power==1,testerlist={c1}];If[testerlist≠Total[testerlist],Print["testerlist failure"]];Table[Print[{co1,Length[wall],power,vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]],co,Length[testerlist]}];tester=testerlist[[co]];ParallelSum[If[Mod[k,50]==0,Print[k]];(tester/.c1->coeflist[[k,2]]/.c2->coeflist[[k,3]]/.c3->coeflist[[k,4]]/.c4->coeflist[[k,5]]/.c5->coeflist[[k,6]]/.c6->coeflist[[k,7]]/.c7->coeflist[[k,8]]/.c8->coeflist[[k,9]]/.c9->coeflist[[k,10]]/.c10->coeflist[[k,11]]/.c11->coeflist[[k,12]]/.c12->coeflist[[k,13]]/.c13->coeflist[[k,14]]/.c14->coeflist[[k,15]]/.c15->coeflist[[k,16]])outsidelist[[k]]//Expand,{k,Length[outsidelist]}],{co,1, Length[testerlist]}]],{power,vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]],vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]]}],{co1,1,Length[wall]}]

Coefficient[%41[[3]], t1^3]

orbitpos[[wall[[-7]]]]

relevantweylgroup[[orbitpos[[wall[[1]]]]]]//Simplify

Table[%[[k]].λtostudy,{k,Length[%]}]//Union

%.Transpose[simproots]//Simplify

λtostudy.Transpose[simproots]//Simplify

Position[relevantweyltranslates,λtostudy]

Residues for E8 series

Initialization

This loads in files defining the Root system.  The file allknown contains the Weyl group elements.

<<"D:\\Documents\\Green Eisenstein\\E8_tables_and_precomputation";Get["D:\\Documents\\Projects\\Exceptional Matrix Groups\\e8minlie"];

This defines the fundamental weights, and ρ

{ω1,ω2,ω3,ω4,ω5,ω6,ω7,ω8}=Inverse[Transpose[simproots]];fundweights={ω1,ω2,ω3,ω4,ω5,ω6,ω7,ω8};ρ=Total[Inverse[Transpose[simproots]]];

This defines a generic element of the Cartan Lie algebra.  The parametrization is not important.

ctnelt=t1 α1+t2 α2 +t3 α3+t4 α4+t5 α5+t6 α6+t7 α7+t8 α8;

This defines a general linear functional on an element of the Cartan Lie algebra.

genλ[{s1_,s2_,s3_,s4_,s5_,s6_,s7_,s8_},elt_]=(s1 ω1+s2 ω2+s3 ω3+s4 ω4+s5 ω5+s6 ω6+s7 ω7+s8 ω8).elt;

This defines (e^((ρ+wλ)H))on an element H of the Cartan Lie algebra.

charonctntblfnmat[mat_]:=Exp[Collect[(ρ+mat.(s1 ω1+s2 ω2+s3 ω3+s4 ω4+s5 ω5+s6 ω6+s7 ω7+s8 ω8)).ctnelt,{t1,t2,t3,t4,t5,t6,t7,t8}]];

These are used in defining the intertwining operators for each element of the Weyl group.

posroots=e8minlie[[2]].simproots;diff=Table[2genλ[{s1,s2,s3,s4,s5,s6,s7,s8},psr]/Norm[psr]^2,{psr,posroots}]//Simplify;

These are the basepoints that are suggested by Arthur' s list :

basepoints={{0,-1,0,1,-1,1,-1,0},{-1,-1,-1,2,-1,0,1,-1},{-1,-1,-1,2,0,0,-1,-1},{3,-1,-1,-1,-1,3,0,0},{0,-1,0,-1,3,-1,-1,-1},{-1,-1,-1,3,-1,-1,-1,1},{-1,0,-1,3,-1,-1,-1,-1},{3,-1,-1,-1,-1,4,-1,-1},{0,-1,4,-1,-1,-1,-1,3},{-1,-1,-1,-1,-1,5,0,0},{-1,-1,-1,-1,4,-1,-1,-1},{0,-1,5,-1,-1,-1,-1,-1},{0,-1,6,-1,-1,-1,-1,-1},{-1,-1,-1,-1,-1,6,-1,-1},{-1,-1,-1,-1,-1,-1,8,0},{-1,7,-1,-1,-1,-1,-1,-1},{8,-1,-1,-1,-1,-1,-1,5},{-1,6,-1,-1,-1,-1,-1,-1},{-1,-1,-1,-1,-1,-1,8,-1},{10,-1,-1,-1,-1,-1,-1,-1},{8,-1,-1,-1,-1,-1,-1,-1},{7,-1,-1,-1,-1,-1,-1,-1},{-1,-1,-1,-1,-1,-1,-1,13},{-1,-1,-1,-1,-1,-1,-1,8},{-1,-1,-1,-1,-1,-1,-1,4},{-1,-1,-1,-1,-1,-1,-1,-1}}

Dimensions[basepoints]

Elimination of Weyl group elements

One must first select a weight.  Then a perturbation is defined in terms of the roots who do not take value - 1 (this is to eliminate many terms).

weightthatdefinesλ=basepoints[[11]]

weightthatdefinesperturb=Table[If[weightthatdefinesλ[[k]]==-1,0,1],{k,Length[weightthatdefinesλ]}]

We convert these to elements of the root system.

λtostudy=weightthatdefinesλ.Inverse[Transpose[simproots]];perturbdirection=weightthatdefinesperturb.Inverse[Transpose[simproots]];

This removes most elements of the Weyl group by discarding elements such that the intertwining operator vanishes on λ (using the - 1' s).

screenflip[mat_]:=(Length[Flatten[Position[Positive[ρ.(mat.Transpose[simproots[[Flatten[Position[weightthatdefinesλ,-1]]]]])],False]]]>0);allknown[{k4a_,k4b_,k4c_,k4d_}]:=-E5Weylgroup[[k4a]].cosets6[[k4b]].cosets7[[k4c]].cosets8[[k4d]];

e8pos5=<<"D:\\Documents\\Green Eisenstein\\e8positions5";

relevantweylgroup=Table[allknown[item],{item,e8pos5}]

Position[e8pos5,item]

Dimensions[relevantweylgroup]

Print["Only ",Length[relevantweylgroup]," elements of the Weyl group are relevant."];

This computes the Weyl orbit of λ and its stabilizer.  It works with the relevantweylgroup.  For each element in the orbit, we keep track of the position in relevantweylgroup of the elements that map λ to it.  It makes two passes through the relevantweylgroup.

relevantweyltranslates=Table[Simplify[relevantweylgroup[[k]].λtostudy],{k,Length[relevantweylgroup]}];relevantorbit=Union[relevantweyltranslates];relevantorbitsize=Length[relevantorbit];relevantorbitbyposition=(relevantweyltranslates/.Table[relevantorbit[[k]]->k,{k,relevantorbitsize}]);orbitpos=Table[Flatten[Position[relevantorbitbyposition,k]],{k,relevantorbitsize}];

Next we compute which elements of the orbit already satisfy Langlands' square-integrability condition, and which do not (hence requiring further calculation to show that their have zero total contribution to the constant term).

alreadybounded=Select[Range[Length[orbitpos]],Max[fundweights.relevantorbit[[#]]]<0&];notalreadybounded=Complement[Range[relevantorbitsize],alreadybounded];wall=Select[Range[Length[orbitpos]],Max[fundweights.relevantorbit[[#]]]==0&];nonwall=Complement[notalreadybounded,wall];Print[Length[alreadybounded], " of the ",relevantorbitsize," relevant orbit terms are in bounded regime."];
Print[Length[notalreadybounded]," are in the unbounded regime.  Of those, ",Length[wall]," lie on the wall."];

screenflip/@relevantweylgroup//Union

We use the following in computing the intertwining operators, with information specific to λ and the perturbation above.

perturbedμtostudy=Solve[s1 ω1+s2 ω2+s3 ω3+s4 ω4+s5 ω5+s6 ω6+s7 ω7+s8 ω8==λtostudy+ϵ perturbdirection,{s1,s2,s3,s4,s5,s6,s7,s8}][[1]];inputtocs=(diff/.perturbedμtostudy//Simplify);

This is broken up into a constant term, and a term which is linear in ϵ.

inputtocs1=Coefficient[inputtocs,ϵ];inputtocs0=(inputtocs/.ϵ->0);

The intertwining operator is computed differently for each positive root (an integer from 1 to Length[posroots]).  cm1(s+1) is the name given to c(s)/(s+1), while cp1(s-1) is the name given to c(s)(s-1) = (s-1)/c(-s) = -1/cm1(-s).  The last 3 commands factor intopfnmat[mat]Exp[ϵ (mat.perturbdirection).ctnelt], which is the summand in the constant term formula, as a rational number, power of epsilon, and exponential.

intertwin[root_]:=If[inputtocs0[[root]]==-1,ϵ inputtocs1[[root]] cm1[ϵ inputtocs1[[root]]],If[inputtocs0[[root]]==1,cp1[ϵ inputtocs1[[root]]]/(ϵ inputtocs1[[root]] ),c[inputtocs[[root]]]]];intopfnmat[mat_]:=Block[{k3,invlist},invlist=Flatten[Position[Positive[ρ.(mat.Transpose[posroots])],False]];Product[intertwin[invlist[[k3]]],{k3,Length[invlist]}]];orderofϵ[mat_]:=Block[{invlist,inputtocsoninvlist},invlist=Flatten[Position[Positive[ρ.(mat.Transpose[posroots])],False]];inputtocsoninvlist=inputtocs0[[invlist]];Count[inputtocsoninvlist,-1]-Count[inputtocsoninvlist,1]];outsideconstant[mat_]:=(ϵ^(-orderofϵ[mat])intopfnmat[mat]/.E->1);exponent[mat_]:=Part[Simplify[intopfnmat[mat]Exp[ϵ(mat.perturbdirection).ctnelt] ϵ^(-orderofϵ[mat])/outsideconstant[mat]],2]

We now check that these commands give the right answers, by going through the expressions they give for each relevant Weyl group element.

(* Union[Table[If[Mod[Position[relevantweylgroup,mat][[1,1]],100]==1,Print[Position[relevantweylgroup,mat][[1,1]]]];intopfnmat[mat]Exp[ϵ(mat.perturbdirection).ctnelt] ==outsideconstant[mat] Exp[exponent[mat]]ϵ^orderofϵ[mat]//Simplify,{mat,relevantweylgroup}]] *)

c[z_]=-Exp[cl[z]-cl[-z]];cm1[z_]=Exp[cm1log[z]];cp1[z_]=-Exp[-cm1log[-z]];

To figure out the power series of the already bounded terms

Finding the order for each relevant Weyl group orbit

Setting up the common orders

We seem to always find that commonorderofϵ is constant on each one.  This checks that assertion.

commonorderofϵalreadybounded=Table[Union[Table[orderofϵ[mat],{mat,relevantweylgroup[[orbitpos[[alreadybounded[[co1]]]]]]}]],{co1,Length[alreadybounded]}]

commonorderofϵnotalreadybounded=Table[Union[Table[orderofϵ[mat],{mat,relevantweylgroup[[orbitpos[[notalreadybounded[[co1]]]]]]}]],{co1,Length[notalreadybounded]}]

commonorderofϵnonwall=Table[Union[Table[orderofϵ[mat],{mat,relevantweylgroup[[orbitpos[[nonwall[[co1]]]]]]}]],{co1,Length[nonwall]}]

commonorderofϵwall=Table[Union[Table[orderofϵ[mat],{mat,relevantweylgroup[[orbitpos[[wall[[co1]]]]]]}]],{co1,Length[wall]}]

Union[Length/@Join[commonorderofϵalreadybounded,commonorderofϵnotalreadybounded]]=={1}

Min[Flatten[commonorderofϵalreadybounded]]

This part is for the alreadybounded analysis

powertocheckto=15;exptemplate=Series[Exp[Sum[ToExpression["c"<>ToString[k]]ϵ^(k),{k,1,powertocheckto}]],{ϵ,0,powertocheckto}];

This makes a table of the exponents, outside constants, and the common order of ϵ for all relevant Weyl group elements that map to a particular already bounded orbit point.

This then looks at the higher coefficients (corresponding to ϵ^(commonorderofϵ + a nonnegative number called "power" here)).  It is supposed to show vanishing up to the order vanishingofalreadyboundedpartuntil.

vanishingofalreadyboundedpartuntil=-2;

Table[coeflist=Table[tmp=exponent[mat];tmp2=CoefficientList[Series[tmp,{ϵ,0,powertocheckto}],ϵ];While[Length[tmp2]<powertocheckto+1,AppendTo[tmp2,0]];If[Total[tmp2]≠Normal[tmp],Print["coeflist formation violation"]];tmp2,{mat,relevantweylgroup[[orbitpos[[alreadybounded[[co1]]]]]]}];outsidelist=Table[outsideconstant[mat],{mat,relevantweylgroup[[orbitpos[[alreadybounded[[co1]]]]]]}];commonorderofϵ=commonorderofϵalreadybounded[[co1]];Table[testerlist=Expand[Simplify[SeriesCoefficient[exptemplate,{ϵ,0,power}]]];If[power==0,testerlist={1}];If[power==1,testerlist={c1}];If[testerlist≠Total[testerlist],Print["testerlist failure"]];Table[Print[{co1,Length[alreadybounded],power,vanishingofalreadyboundedpartuntil-commonorderofϵ[[1]],co,Length[testerlist]}];tester=testerlist[[co]];ParallelSum[If[Mod[k,50]==0,Print[{k,Length[outsidelist]}]];(tester/.c1->coeflist[[k,2]]/.c2->coeflist[[k,3]]/.c3->coeflist[[k,4]]/.c4->coeflist[[k,5]]/.c5->coeflist[[k,6]]/.c6->coeflist[[k,7]]/.c7->coeflist[[k,8]]/.c8->coeflist[[k,9]]/.c9->coeflist[[k,10]]/.c10->coeflist[[k,11]]/.c11->coeflist[[k,12]]/.c12->coeflist[[k,13]]/.c13->coeflist[[k,14]]/.c14->coeflist[[k,15]]/.c15->coeflist[[k,16]])outsidelist[[k]]//Expand,{k,Length[outsidelist]}],{co,1, Length[testerlist]}],{power,0,vanishingofalreadyboundedpartuntil-commonorderofϵ[[1]]}],{co1,1,Length[alreadybounded]}]

Flatten[%]//Union

We need at least one of these to not vanish to the next order :

Table[coeflist=Table[tmp=exponent[mat];tmp2=CoefficientList[Series[tmp,{ϵ,0,powertocheckto}],ϵ];While[Length[tmp2]<powertocheckto+1,AppendTo[tmp2,0]];If[Total[tmp2]≠Normal[tmp],Print["coeflist formation violation"]];tmp2,{mat,relevantweylgroup[[orbitpos[[alreadybounded[[co1]]]]]]}];outsidelist=Table[outsideconstant[mat],{mat,relevantweylgroup[[orbitpos[[alreadybounded[[co1]]]]]]}];commonorderofϵ=commonorderofϵalreadybounded[[co1]];Table[If[power≥0,testerlist=Expand[Simplify[SeriesCoefficient[exptemplate,{ϵ,0,power}]]];If[power==0,testerlist={1}];If[power==1,testerlist={c1}];If[testerlist≠Total[testerlist],Print["testerlist failure"]];Table[Print[{co1,power,co,Length[testerlist]}];tester=testerlist[[co]];ParallelSum[Print[k];(tester/.c1->coeflist[[k,2]]/.c2->coeflist[[k,3]]/.c3->coeflist[[k,4]]/.c4->coeflist[[k,5]]/.c5->coeflist[[k,6]]/.c6->coeflist[[k,7]]/.c7->coeflist[[k,8]]/.c8->coeflist[[k,9]]/.c9->coeflist[[k,10]]/.c10->coeflist[[k,11]]/.c11->coeflist[[k,12]]/.c12->coeflist[[k,13]]/.c13->coeflist[[k,14]]/.c14->coeflist[[k,15]]/.c15->coeflist[[k,16]])outsidelist[[k]]//Expand,{k,Length[outsidelist]}],{co,1, Length[testerlist]}]],{power,vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]],vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]]}],{co1,(* 1*) 1,Length[alreadybounded](*Length[alreadybounded]*)}]

This part is for the notalreadybounded-nonwall analysis

powertocheckto=15;exptemplate=Series[Exp[Sum[ToExpression["c"<>ToString[k]]ϵ^(k),{k,1,powertocheckto}]],{ϵ,0,powertocheckto}];

This does a similar analysis for the orbits off the wall, and shows they vanish to a higher order than the already bounded ones.

Table[coeflist=Table[tmp=exponent[mat];tmp2=CoefficientList[Series[tmp,{ϵ,0,powertocheckto}],ϵ];While[Length[tmp2]<powertocheckto+1,AppendTo[tmp2,0]];If[Total[tmp2]≠Normal[tmp],Print["coeflist formation violation"]];tmp2,{mat,relevantweylgroup[[orbitpos[[nonwall[[co1]]]]]]}];outsidelist=Table[outsideconstant[mat],{mat,relevantweylgroup[[orbitpos[[nonwall[[co1]]]]]]}];commonorderofϵ=commonorderofϵnonwall[[co1]];Table[testerlist=Expand[Simplify[SeriesCoefficient[exptemplate,{ϵ,0,power}]]];If[power==0,testerlist={1}];If[power==1,testerlist={c1}];If[testerlist≠Total[testerlist],Print["testerlist failure"]];Table[Print[{co1,Length[nonwall],power,vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]],co,Length[testerlist]}];tester=testerlist[[co]];ParallelSum[If[Mod[k,50]==0,Print[k]];(tester/.c1->coeflist[[k,2]]/.c2->coeflist[[k,3]]/.c3->coeflist[[k,4]]/.c4->coeflist[[k,5]]/.c5->coeflist[[k,6]]/.c6->coeflist[[k,7]]/.c7->coeflist[[k,8]]/.c8->coeflist[[k,9]]/.c9->coeflist[[k,10]]/.c10->coeflist[[k,11]]/.c11->coeflist[[k,12]]/.c12->coeflist[[k,13]]/.c13->coeflist[[k,14]]/.c14->coeflist[[k,15]]/.c15->coeflist[[k,16]])outsidelist[[k]]//Expand,{k,Length[outsidelist]}],{co,1, Length[testerlist]}],{power,0,vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]]}],{co1,1,Length[nonwall]}]

Flatten[%]//Union

This part is for the notalreadybounded - wall analysis

This first checks that the wall terms vanish to at least the same order as the already bounded ones.

powertocheckto=15;exptemplate=Series[Exp[Sum[ToExpression["c"<>ToString[k]]ϵ^(k),{k,1,powertocheckto}]],{ϵ,0,powertocheckto}];

Table[coeflist=Table[tmp=exponent[mat];tmp2=CoefficientList[Series[tmp,{ϵ,0,powertocheckto}],ϵ];While[Length[tmp2]<powertocheckto+1,AppendTo[tmp2,0]];If[Total[tmp2]≠Normal[tmp],Print["coeflist formation violation"]];tmp2,{mat,relevantweylgroup[[orbitpos[[wall[[co1]]]]]]}];outsidelist=Table[outsideconstant[mat],{mat,relevantweylgroup[[orbitpos[[wall[[co1]]]]]]}];commonorderofϵ=commonorderofϵwall[[co1]];Table[testerlist=Expand[Simplify[SeriesCoefficient[exptemplate,{ϵ,0,power}]]];If[power==0,testerlist={1}];If[power==1,testerlist={c1}];If[testerlist≠Total[testerlist],Print["testerlist failure"]];Table[Print[{co1,Length[wall],power,vanishingofalreadyboundedpartuntil-commonorderofϵ[[1]],co,Length[testerlist]}];tester=testerlist[[co]];ParallelSum[If[Mod[k,50]==0,Print[k]];(tester/.c1->coeflist[[k,2]]/.c2->coeflist[[k,3]]/.c3->coeflist[[k,4]]/.c4->coeflist[[k,5]]/.c5->coeflist[[k,6]]/.c6->coeflist[[k,7]]/.c7->coeflist[[k,8]]/.c8->coeflist[[k,9]]/.c9->coeflist[[k,10]]/.c10->coeflist[[k,11]]/.c11->coeflist[[k,12]]/.c12->coeflist[[k,13]]/.c13->coeflist[[k,14]]/.c14->coeflist[[k,15]]/.c15->coeflist[[k,16]])outsidelist[[k]]//Expand,{k,Length[outsidelist]}],{co,1, Length[testerlist]}],{power,0,vanishingofalreadyboundedpartuntil-commonorderofϵ[[1]]}],{co1,1,Length[wall]}]

Flatten[%]//Union

Next we see if this vanishing goes further:

Table[coeflist=Table[tmp=exponent[mat];tmp2=CoefficientList[Series[tmp,{ϵ,0,powertocheckto}],ϵ];While[Length[tmp2]<powertocheckto+1,AppendTo[tmp2,0]];If[Total[tmp2]≠Normal[tmp],Print["coeflist formation violation"]];tmp2,{mat,relevantweylgroup[[orbitpos[[wall[[co1]]]]]]}];outsidelist=Table[outsideconstant[mat],{mat,relevantweylgroup[[orbitpos[[wall[[co1]]]]]]}];commonorderofϵ=commonorderofϵwall[[co1]];Table[If[power≥0,testerlist=Expand[Simplify[SeriesCoefficient[exptemplate,{ϵ,0,power}]]];If[power==0,testerlist={1}];If[power==1,testerlist={c1}];If[testerlist≠Total[testerlist],Print["testerlist failure"]];Table[Print[{co1,Length[wall],power,vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]],co,Length[testerlist]}];tester=testerlist[[co]];ParallelSum[If[Mod[k,50]==0,Print[k]];(tester/.c1->coeflist[[k,2]]/.c2->coeflist[[k,3]]/.c3->coeflist[[k,4]]/.c4->coeflist[[k,5]]/.c5->coeflist[[k,6]]/.c6->coeflist[[k,7]]/.c7->coeflist[[k,8]]/.c8->coeflist[[k,9]]/.c9->coeflist[[k,10]]/.c10->coeflist[[k,11]]/.c11->coeflist[[k,12]]/.c12->coeflist[[k,13]]/.c13->coeflist[[k,14]]/.c14->coeflist[[k,15]]/.c15->coeflist[[k,16]])outsidelist[[k]]//Expand,{k,Length[outsidelist]}],{co,1, Length[testerlist]}]],{power,vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]],vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]]}],{co1,1,Length[wall]}]

orbitpos[[wall[[-7]]]]

relevantweylgroup[[orbitpos[[wall[[1]]]]]]//Simplify

Table[%[[k]].λtostudy,{k,Length[%]}]//Union

%.Transpose[simproots]//Simplify

λtostudy.Transpose[simproots]//Simplify

Position[relevantweyltranslates,λtostudy]

Residues for D5 series

Initialization

This loads in files defining the Root system.  The file allknown contains the Weyl group elements.

<<"D:\\Documents\\Green Eisenstein\\D5_tables_and_precomputation";d5minlie=<<"D:\\Mathematica Files\\d5minlie";

This defines the fundamental weights, and ρ

{ω1,ω2,ω3,ω4,ω5}=Inverse[Transpose[simproots]];fundweights={ω1,ω2,ω3,ω4,ω5};ρ=Total[Inverse[Transpose[simproots]]];

This defines a generic element of the Cartan Lie algebra.  The parametrization is not important.

ctnelt=t1 α1+t2 α2 +t3 α3+t4 α4+t5 α5;

This defines a general linear functional on an element of the Cartan Lie algebra.

genλ[{s1_,s2_,s3_,s4_,s5_},elt_]=(s1 ω1+s2 ω2+s3 ω3+s4 ω4+s5 ω5).elt;

This defines (e^((ρ+wλ)H))on an element H of the Cartan Lie algebra.

charonctntblfnmat[mat_]:=Exp[Collect[(ρ+mat.(s1 ω1+s2 ω2+s3 ω3+s4 ω4+s5 ω5)).ctnelt,{t1,t2,t3,t4,t5}]];

These are used in defining the intertwining operators for each element of the Weyl group.

posroots=d5minlie[[2]].simproots;diff=Table[2genλ[{s1,s2,s3,s4,s5},psr]/Norm[psr]^2,{psr,posroots}]//Simplify;

These are the basepoints that are suggested by Arthur' s list :

basepoints={{0,0,1,-1,-1},{-1,1,1,-1,-1},{-1,-1,2,-1,-1},{0,2,-1,-1,-1},{-1,3,-1,-1,-1},{-1,-1,-1,-1,3},{3,-1,-1,-1,-1},{2,-1,-1,-1,-1},{-1,-1,-1,-1,-1}};

Dimensions[basepoints]

Elimination of Weyl group elements

One must first select a weight.  Then a perturbation is defined in terms of the roots who do not take value - 1 (this is to eliminate many terms).

weightthatdefinesλ=basepoints[[8]]

weightthatdefinesperturb=Table[If[weightthatdefinesλ[[k]]==-1,0,1],{k,Length[weightthatdefinesλ]}]

We convert these to elements of the root system.

λtostudy=weightthatdefinesλ.Inverse[Transpose[simproots]];perturbdirection=weightthatdefinesperturb.Inverse[Transpose[simproots]];

This removes most elements of the Weyl group by discarding elements such that the intertwining operator vanishes on λ (using the - 1' s).

screenflip[mat_]:=(Length[Flatten[Position[Positive[ρ.(mat.Transpose[simproots[[Flatten[Position[weightthatdefinesλ,-1]]]]])],False]]]>0);relevantweylgroup=Select[allknown,screenflip[#]==False&];Print["Only ",Length[relevantweylgroup]," elements of the Weyl group are relevant."];

This computes the Weyl orbit of λ and its stabilizer.  It works with the relevantweylgroup.  For each element in the orbit, we keep track of the position in relevantweylgroup of the elements that map λ to it.  It makes two passes through the relevantweylgroup.

relevantweyltranslates=Table[Simplify[relevantweylgroup[[k]].λtostudy],{k,Length[relevantweylgroup]}];relevantorbit=Union[relevantweyltranslates];relevantorbitsize=Length[relevantorbit];relevantorbitbyposition=(relevantweyltranslates/.Table[relevantorbit[[k]]->k,{k,relevantorbitsize}]);orbitpos=Table[Flatten[Position[relevantorbitbyposition,k]],{k,relevantorbitsize}];

Next we compute which elements of the orbit already satisfy Langlands' square-integrability condition, and which do not (hence requiring further calculation to show that their have zero total contribution to the constant term).

alreadybounded=Select[Range[Length[orbitpos]],Max[fundweights.relevantorbit[[#]]]<0&];notalreadybounded=Complement[Range[relevantorbitsize],alreadybounded];wall=Select[Range[Length[orbitpos]],Max[fundweights.relevantorbit[[#]]]==0&];nonwall=Complement[notalreadybounded,wall];Print[Length[alreadybounded], " of the ",relevantorbitsize," relevant orbit terms are in bounded regime."];
Print[Length[notalreadybounded]," are in the unbounded regime.  Of those, ",Length[wall]," lie on the wall."];

We use the following in computing the intertwining operators, with information specific to λ and the perturbation above.

perturbedμtostudy=Solve[s1 ω1+s2 ω2+s3 ω3+s4 ω4+s5 ω5==λtostudy+ϵ perturbdirection,{s1,s2,s3,s4,s5}][[1]];inputtocs=(diff/.perturbedμtostudy//Simplify);

This is broken up into a constant term, and a term which is linear in ϵ.

inputtocs1=Coefficient[inputtocs,ϵ];inputtocs0=(inputtocs/.ϵ->0);

The intertwining operator is computed differently for each positive root (an integer from 1 to Length[posroots]).  cm1(s+1) is the name given to c(s)/(s+1), while cp1(s-1) is the name given to c(s)(s-1) = (s-1)/c(-s) = -1/cm1(-s).  The last 3 commands factor intopfnmat[mat]Exp[ϵ (mat.perturbdirection).ctnelt], which is the summand in the constant term formula, as a rational number, power of epsilon, and exponential.

intertwin[root_]:=If[inputtocs0[[root]]==-1,ϵ inputtocs1[[root]] cm1[ϵ inputtocs1[[root]]],If[inputtocs0[[root]]==1,cp1[ϵ inputtocs1[[root]]]/(ϵ inputtocs1[[root]] ),c[inputtocs[[root]]]]];intopfnmat[mat_]:=Block[{k3,invlist},invlist=Flatten[Position[Positive[ρ.(mat.Transpose[posroots])],False]];Product[intertwin[invlist[[k3]]],{k3,Length[invlist]}]];orderofϵ[mat_]:=Block[{invlist,inputtocsoninvlist},invlist=Flatten[Position[Positive[ρ.(mat.Transpose[posroots])],False]];inputtocsoninvlist=inputtocs0[[invlist]];Count[inputtocsoninvlist,-1]-Count[inputtocsoninvlist,1]];outsideconstant[mat_]:=(ϵ^(-orderofϵ[mat])intopfnmat[mat]/.E->1);exponent[mat_]:=Part[Simplify[intopfnmat[mat]Exp[ϵ(mat.perturbdirection).ctnelt] ϵ^(-orderofϵ[mat])/outsideconstant[mat]],2]

We now check that these commands give the right answers, by going through the expressions they give for each relevant Weyl group element.

Union[ParallelTable[If[Mod[Position[relevantweylgroup,mat][[1,1]],100]==1,Print[Position[relevantweylgroup,mat][[1,1]]]];intopfnmat[mat]Exp[ϵ(mat.perturbdirection).ctnelt] ==outsideconstant[mat] Exp[exponent[mat]]ϵ^orderofϵ[mat]//Simplify,{mat,relevantweylgroup}]]

c[z_]=-Exp[cl[z]-cl[-z]];cm1[z_]=Exp[cm1log[z]];cp1[z_]=-Exp[-cm1log[-z]];

To figure out the power series of the already bounded terms

Finding the order for each relevant Weyl group orbit

Setting up the common orders

We seem to always find that commonorderofϵ is constant on each one.  This checks that assertion.

commonorderofϵalreadybounded=Table[Union[Table[orderofϵ[mat],{mat,relevantweylgroup[[orbitpos[[alreadybounded[[co1]]]]]]}]],{co1,Length[alreadybounded]}]

commonorderofϵnotalreadybounded=Table[Union[Table[orderofϵ[mat],{mat,relevantweylgroup[[orbitpos[[notalreadybounded[[co1]]]]]]}]],{co1,Length[notalreadybounded]}]

commonorderofϵnonwall=Table[Union[Table[orderofϵ[mat],{mat,relevantweylgroup[[orbitpos[[nonwall[[co1]]]]]]}]],{co1,Length[nonwall]}]

commonorderofϵwall=Table[Union[Table[orderofϵ[mat],{mat,relevantweylgroup[[orbitpos[[wall[[co1]]]]]]}]],{co1,Length[wall]}]

Union[Length/@Join[commonorderofϵalreadybounded,commonorderofϵnotalreadybounded]]=={1}

Min[Flatten[commonorderofϵalreadybounded]]

This part is for the alreadybounded analysis

powertocheckto=15;exptemplate=Series[Exp[Sum[ToExpression["c"<>ToString[k]]ϵ^(k),{k,1,powertocheckto}]],{ϵ,0,powertocheckto}];

This makes a table of the exponents, outside constants, and the common order of ϵ for all relevant Weyl group elements that map to a particular already bounded orbit point.

This then looks at the higher coefficients (corresponding to ϵ^(commonorderofϵ + a nonnegative number called "power" here)).  It is supposed to show vanishing up to the order vanishingofalreadyboundedpartuntil.

vanishingofalreadyboundedpartuntil=-1;

Table[coeflist=Table[tmp=exponent[mat];tmp2=CoefficientList[Series[tmp,{ϵ,0,powertocheckto}],ϵ];While[Length[tmp2]<powertocheckto+1,AppendTo[tmp2,0]];If[Total[tmp2]≠Normal[tmp],Print["coeflist formation violation"]];tmp2,{mat,relevantweylgroup[[orbitpos[[alreadybounded[[co1]]]]]]}];outsidelist=Table[outsideconstant[mat],{mat,relevantweylgroup[[orbitpos[[alreadybounded[[co1]]]]]]}];commonorderofϵ=commonorderofϵalreadybounded[[co1]];Table[testerlist=Expand[Simplify[SeriesCoefficient[exptemplate,{ϵ,0,power}]]];If[power==0,testerlist={1}];If[power==1,testerlist={c1}];If[testerlist≠Total[testerlist],Print["testerlist failure"]];Table[Print[{co1,Length[alreadybounded],power,vanishingofalreadyboundedpartuntil-commonorderofϵ[[1]],co,Length[testerlist]}];tester=testerlist[[co]];ParallelSum[If[Mod[k,50]==0,Print[{k,Length[outsidelist]}]];(tester/.c1->coeflist[[k,2]]/.c2->coeflist[[k,3]]/.c3->coeflist[[k,4]]/.c4->coeflist[[k,5]]/.c5->coeflist[[k,6]]/.c6->coeflist[[k,7]]/.c7->coeflist[[k,8]]/.c8->coeflist[[k,9]]/.c9->coeflist[[k,10]]/.c10->coeflist[[k,11]]/.c11->coeflist[[k,12]]/.c12->coeflist[[k,13]]/.c13->coeflist[[k,14]]/.c14->coeflist[[k,15]]/.c15->coeflist[[k,16]])outsidelist[[k]]//Expand,{k,Length[outsidelist]}],{co,1, Length[testerlist]}],{power,0,vanishingofalreadyboundedpartuntil-commonorderofϵ[[1]]}],{co1,1,Length[alreadybounded]}]

Flatten[%]//Union

We need at least one of these to not vanish to the next order :

Table[coeflist=Table[tmp=exponent[mat];tmp2=CoefficientList[Series[tmp,{ϵ,0,powertocheckto}],ϵ];While[Length[tmp2]<powertocheckto+1,AppendTo[tmp2,0]];If[Total[tmp2]≠Normal[tmp],Print["coeflist formation violation"]];tmp2,{mat,relevantweylgroup[[orbitpos[[alreadybounded[[co1]]]]]]}];outsidelist=Table[outsideconstant[mat],{mat,relevantweylgroup[[orbitpos[[alreadybounded[[co1]]]]]]}];commonorderofϵ=commonorderofϵalreadybounded[[co1]];Table[If[power≥0,testerlist=Expand[Simplify[SeriesCoefficient[exptemplate,{ϵ,0,power}]]];If[power==0,testerlist={1}];If[power==1,testerlist={c1}];If[testerlist≠Total[testerlist],Print["testerlist failure"]];Table[Print[{co1,power,co,Length[testerlist]}];tester=testerlist[[co]];ParallelSum[If[Mod[k,50]==0,Print[k]];(tester/.c1->coeflist[[k,2]]/.c2->coeflist[[k,3]]/.c3->coeflist[[k,4]]/.c4->coeflist[[k,5]]/.c5->coeflist[[k,6]]/.c6->coeflist[[k,7]]/.c7->coeflist[[k,8]]/.c8->coeflist[[k,9]]/.c9->coeflist[[k,10]]/.c10->coeflist[[k,11]]/.c11->coeflist[[k,12]]/.c12->coeflist[[k,13]]/.c13->coeflist[[k,14]]/.c14->coeflist[[k,15]]/.c15->coeflist[[k,16]])outsidelist[[k]]//Expand,{k,Length[outsidelist]}],{co,1, Length[testerlist]}]],{power,vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]],vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]]}],{co1,(* 1*) 1,Length[alreadybounded](*Length[alreadybounded]*)}]

Coefficient[%,t1 ]

This part is for the notalreadybounded-nonwall analysis

powertocheckto=15;exptemplate=Series[Exp[Sum[ToExpression["c"<>ToString[k]]ϵ^(k),{k,1,powertocheckto}]],{ϵ,0,powertocheckto}];

This does a similar analysis for the orbits off the wall, and shows they vanish to a higher order than the already bounded ones.

Table[coeflist=Table[tmp=exponent[mat];tmp2=CoefficientList[Series[tmp,{ϵ,0,powertocheckto}],ϵ];While[Length[tmp2]<powertocheckto+1,AppendTo[tmp2,0]];If[Total[tmp2]≠Normal[tmp],Print["coeflist formation violation"]];tmp2,{mat,relevantweylgroup[[orbitpos[[nonwall[[co1]]]]]]}];outsidelist=Table[outsideconstant[mat],{mat,relevantweylgroup[[orbitpos[[nonwall[[co1]]]]]]}];commonorderofϵ=commonorderofϵnonwall[[co1]];Table[testerlist=Expand[Simplify[SeriesCoefficient[exptemplate,{ϵ,0,power}]]];If[power==0,testerlist={1}];If[power==1,testerlist={c1}];If[testerlist≠Total[testerlist],Print["testerlist failure"]];Table[Print[{co1,Length[nonwall],power,vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]],co,Length[testerlist]}];tester=testerlist[[co]];ParallelSum[If[Mod[k,50]==0,Print[k]];(tester/.c1->coeflist[[k,2]]/.c2->coeflist[[k,3]]/.c3->coeflist[[k,4]]/.c4->coeflist[[k,5]]/.c5->coeflist[[k,6]]/.c6->coeflist[[k,7]]/.c7->coeflist[[k,8]]/.c8->coeflist[[k,9]]/.c9->coeflist[[k,10]]/.c10->coeflist[[k,11]]/.c11->coeflist[[k,12]]/.c12->coeflist[[k,13]]/.c13->coeflist[[k,14]]/.c14->coeflist[[k,15]]/.c15->coeflist[[k,16]])outsidelist[[k]]//Expand,{k,Length[outsidelist]}],{co,1, Length[testerlist]}],{power,0,vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]]}],{co1,1,Length[nonwall]}]

Flatten[%]//Union

This part is for the notalreadybounded - wall analysis

This first checks that the wall terms vanish to at least the same order as the already bounded ones.

powertocheckto=15;exptemplate=Series[Exp[Sum[ToExpression["c"<>ToString[k]]ϵ^(k),{k,1,powertocheckto}]],{ϵ,0,powertocheckto}];

Table[coeflist=Table[tmp=exponent[mat];tmp2=CoefficientList[Series[tmp,{ϵ,0,powertocheckto}],ϵ];While[Length[tmp2]<powertocheckto+1,AppendTo[tmp2,0]];If[Total[tmp2]≠Normal[tmp],Print["coeflist formation violation"]];tmp2,{mat,relevantweylgroup[[orbitpos[[wall[[co1]]]]]]}];outsidelist=Table[outsideconstant[mat],{mat,relevantweylgroup[[orbitpos[[wall[[co1]]]]]]}];commonorderofϵ=commonorderofϵwall[[co1]];Table[testerlist=Expand[Simplify[SeriesCoefficient[exptemplate,{ϵ,0,power}]]];If[power==0,testerlist={1}];If[power==1,testerlist={c1}];If[testerlist≠Total[testerlist],Print["testerlist failure"]];Table[Print[{co1,Length[wall],power,vanishingofalreadyboundedpartuntil-commonorderofϵ[[1]],co,Length[testerlist]}];tester=testerlist[[co]];ParallelSum[If[Mod[k,50]==0,Print[k]];(tester/.c1->coeflist[[k,2]]/.c2->coeflist[[k,3]]/.c3->coeflist[[k,4]]/.c4->coeflist[[k,5]]/.c5->coeflist[[k,6]]/.c6->coeflist[[k,7]]/.c7->coeflist[[k,8]]/.c8->coeflist[[k,9]]/.c9->coeflist[[k,10]]/.c10->coeflist[[k,11]]/.c11->coeflist[[k,12]]/.c12->coeflist[[k,13]]/.c13->coeflist[[k,14]]/.c14->coeflist[[k,15]]/.c15->coeflist[[k,16]])outsidelist[[k]]//Expand,{k,Length[outsidelist]}],{co,1, Length[testerlist]}],{power,0,vanishingofalreadyboundedpartuntil-commonorderofϵ[[1]]}],{co1,1,Length[wall]}]

Flatten[%]//Union

Next we see if this vanishing goes further:

Table[coeflist=Table[tmp=exponent[mat];tmp2=CoefficientList[Series[tmp,{ϵ,0,powertocheckto}],ϵ];While[Length[tmp2]<powertocheckto+1,AppendTo[tmp2,0]];If[Total[tmp2]≠Normal[tmp],Print["coeflist formation violation"]];tmp2,{mat,relevantweylgroup[[orbitpos[[wall[[co1]]]]]]}];outsidelist=Table[outsideconstant[mat],{mat,relevantweylgroup[[orbitpos[[wall[[co1]]]]]]}];commonorderofϵ=commonorderofϵwall[[co1]];Table[If[power≥0,testerlist=Expand[Simplify[SeriesCoefficient[exptemplate,{ϵ,0,power}]]];If[power==0,testerlist={1}];If[power==1,testerlist={c1}];If[testerlist≠Total[testerlist],Print["testerlist failure"]];Table[Print[{co1,Length[wall],power,vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]],co,Length[testerlist]}];tester=testerlist[[co]];ParallelSum[If[Mod[k,50]==0,Print[k]];(tester/.c1->coeflist[[k,2]]/.c2->coeflist[[k,3]]/.c3->coeflist[[k,4]]/.c4->coeflist[[k,5]]/.c5->coeflist[[k,6]]/.c6->coeflist[[k,7]]/.c7->coeflist[[k,8]]/.c8->coeflist[[k,9]]/.c9->coeflist[[k,10]]/.c10->coeflist[[k,11]]/.c11->coeflist[[k,12]]/.c12->coeflist[[k,13]]/.c13->coeflist[[k,14]]/.c14->coeflist[[k,15]]/.c15->coeflist[[k,16]])outsidelist[[k]]//Expand,{k,Length[outsidelist]}],{co,1, Length[testerlist]}]],{power,vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]],vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]]}],{co1,1,Length[wall]}]

Union[Flatten[%]]

%149[[2]]

Coefficient[%, -8 (t1^3) t2]

orbitpos[[wall[[-7]]]]

relevantweylgroup[[orbitpos[[wall[[1]]]]]]//Simplify

Table[%[[k]].λtostudy,{k,Length[%]}]//Union

%.Transpose[simproots]//Simplify

λtostudy.Transpose[simproots]//Simplify

Position[relevantweyltranslates,λtostudy]

Residues for F4 series

Initialization

posroots={{1,0,0,0},{0,1,0,0},{0,0,1,0},{0,0,0,1},{1,1,0,0},{1,0,1,0},{1,0,0,1},{0,1,1,0},{0,1,0,1},{0,0,1,1},{1,-1,0,0},{1,0,-1,0},{1,0,0,-1},{0,1,-1,0},{0,1,0,-1},{0,0,1,-1},{(1/2),(1/2),(1/2),(1/2)},{-(1/2),(1/2),(1/2),(1/2)},{(1/2),-(1/2),(1/2),(1/2)},{(1/2),(1/2),-(1/2),(1/2)},{(1/2),(1/2),(1/2),-(1/2)},{-(1/2),(1/2),(1/2),-(1/2)},{(1/2),-(1/2),(1/2),-(1/2)},{(1/2),(1/2),-(1/2),-(1/2)}};ρ=Total[posroots]/2;simproots=posroots[[{14,11,22,4}]];{α1,α2,α3,α4}=simproots;s[v_]:=IdentityMatrix[4]-2 Transpose[{v}].{v}/v.v;weylgen=Table[s[simproots[[k]]],{k,4}];Table[s[simproots[[k]]]//MatrixForm,{k,4}];length1=Union[weylgen,{IdentityMatrix[4]}];length2=Union[Flatten[Table[length1[[k1]].length1[[k2]],{k1,3},{k2,5}],1]];length4=Union[Flatten[Table[length2[[k1]].length2[[k2]],{k1,12},{k2,12}],1]];allknown=length4;Do[allknown=Union[allknown,Table[allknown[[k1]].length1[[k2]],{k1,Length[allknown]}]],{k2,5}];Do[allknown=Union[allknown,Table[allknown[[k1]].length1[[k2]],{k1,Length[allknown]}]],{k2,5}];Do[allknown=Union[allknown,Table[allknown[[k1]].length1[[k2]],{k1,Length[allknown]}]],{k2,5}];Do[allknown=Union[allknown,Table[allknown[[k1]].length1[[k2]],{k1,Length[allknown]}]],{k2,5}];Do[allknown=Union[allknown,Table[allknown[[k1]].length1[[k2]],{k1,Length[allknown]}]],{k2,5}];{ω1,ω2,ω3,ω4}=Inverse[Transpose[Table[α 2/Norm[α]^2,{α,simproots}]]];fundweights={ω1,ω2,ω3,ω4};ctnelt=t1 α1+t2 α2 +t3 α3+t4 α4;genλ[{s1_,s2_,s3_,s4_},elt_]=(s1 ω1+s2 ω2+s3 ω3+s4 ω4).elt;charonctntblfnmat[mat_]:=Exp[Collect[(ρ+mat.(s1 ω1+s2 ω2+s3 ω3+s4 ω4)).ctnelt,{t1,t2,t3,t4}]];diff=Table[2genλ[{s1,s2,s3,s4},psr]/Norm[psr]^2,{psr,posroots}]//Simplify;

These are the basepoints that are suggested by Arthur' s list :

basepoints={{-1,1,-1,-1},{2,-1,-1,-1},{1,-1,-1,-1},{-1,-1,-1,-1}};

Dimensions[basepoints]

fundweights.Transpose[simproots]

Elimination of Weyl group elements

One must first select a weight.  Then a perturbation is defined in terms of the roots who do not take value - 1 (this is to eliminate many terms).

weightthatdefinesλ={0,0,-1,0}

weightthatdefinesperturb=Table[If[weightthatdefinesλ[[k]]==-1,0,1],{k,Length[weightthatdefinesλ]}]

We convert these to elements of the root system.

λtostudy=weightthatdefinesλ.fundweights;perturbdirection=weightthatdefinesperturb.fundweights;

This removes most elements of the Weyl group by discarding elements such that the intertwining operator vanishes on λ (using the - 1' s).

screenflip[mat_]:=(Length[Flatten[Position[Positive[ρ.(mat.Transpose[simproots[[Flatten[Position[weightthatdefinesλ,-1]]]]])],False]]]>0);relevantweylgroup=Select[allknown,screenflip[#]==False&];Print["Only ",Length[relevantweylgroup]," elements of the Weyl group are relevant."];

This computes the Weyl orbit of λ and its stabilizer.  It works with the relevantweylgroup.  For each element in the orbit, we keep track of the position in relevantweylgroup of the elements that map λ to it.  It makes two passes through the relevantweylgroup.

relevantweyltranslates=Table[Simplify[relevantweylgroup[[k]].λtostudy],{k,Length[relevantweylgroup]}];relevantorbit=Union[relevantweyltranslates];relevantorbitsize=Length[relevantorbit];relevantorbitbyposition=(relevantweyltranslates/.Table[relevantorbit[[k]]->k,{k,relevantorbitsize}]);orbitpos=Table[Flatten[Position[relevantorbitbyposition,k]],{k,relevantorbitsize}];

Next we compute which elements of the orbit already satisfy Langlands' square-integrability condition, and which do not (hence requiring further calculation to show that their have zero total contribution to the constant term).

alreadybounded=Select[Range[Length[orbitpos]],Max[fundweights.relevantorbit[[#]]]<0&];notalreadybounded=Complement[Range[relevantorbitsize],alreadybounded];wall=Select[Range[Length[orbitpos]],Max[fundweights.relevantorbit[[#]]]==0&];nonwall=Complement[notalreadybounded,wall];Print[Length[alreadybounded], " of the ",relevantorbitsize," relevant orbit terms are in bounded regime."];
Print[Length[notalreadybounded]," are in the unbounded regime.  Of those, ",Length[wall]," lie on the wall."];

We use the following in computing the intertwining operators, with information specific to λ and the perturbation above.

perturbedμtostudy=Solve[s1 ω1+s2 ω2+s3 ω3+s4 ω4==λtostudy+ϵ perturbdirection,{s1,s2,s3,s4}][[1]];inputtocs=(diff/.perturbedμtostudy//Simplify);

This is broken up into a constant term, and a term which is linear in ϵ.

inputtocs1=Coefficient[inputtocs,ϵ];inputtocs0=(inputtocs/.ϵ->0);

The intertwining operator is computed differently for each positive root (an integer from 1 to Length[posroots]).  cm1(s+1) is the name given to c(s)/(s+1), while cp1(s-1) is the name given to c(s)(s-1) = (s-1)/c(-s) = -1/cm1(-s).  The last 3 commands factor intopfnmat[mat]Exp[ϵ (mat.perturbdirection).ctnelt], which is the summand in the constant term formula, as a rational number, power of epsilon, and exponential.

intertwin[root_]:=If[inputtocs0[[root]]==-1,ϵ inputtocs1[[root]] cm1[ϵ inputtocs1[[root]]],If[inputtocs0[[root]]==1,cp1[ϵ inputtocs1[[root]]]/(ϵ inputtocs1[[root]] ),c[inputtocs[[root]]]]];intopfnmat[mat_]:=Block[{k3,invlist},invlist=Flatten[Position[Positive[ρ.(mat.Transpose[posroots])],False]];Product[intertwin[invlist[[k3]]],{k3,Length[invlist]}]];orderofϵ[mat_]:=Block[{invlist,inputtocsoninvlist},invlist=Flatten[Position[Positive[ρ.(mat.Transpose[posroots])],False]];inputtocsoninvlist=inputtocs0[[invlist]];Count[inputtocsoninvlist,-1]-Count[inputtocsoninvlist,1]];outsideconstant[mat_]:=(ϵ^(-orderofϵ[mat])intopfnmat[mat]/.E->1);exponent[mat_]:=Part[Simplify[intopfnmat[mat]Exp[ϵ(mat.perturbdirection).ctnelt] ϵ^(-orderofϵ[mat])/outsideconstant[mat]],2]

We now check that these commands give the right answers, by going through the expressions they give for each relevant Weyl group element.

Union[ParallelTable[If[Mod[Position[relevantweylgroup,mat][[1,1]],100]==1,Print[Position[relevantweylgroup,mat][[1,1]]]];intopfnmat[mat]Exp[ϵ(mat.perturbdirection).ctnelt] ==outsideconstant[mat] Exp[exponent[mat]]ϵ^orderofϵ[mat]//Simplify,{mat,relevantweylgroup}]]

c[z_]=-Exp[cl[z]-cl[-z]];cm1[z_]=Exp[cm1log[z]];cp1[z_]=-Exp[-cm1log[-z]];

To figure out the power series of the already bounded terms

Finding the order for each relevant Weyl group orbit

Setting up the common orders

We seem to always find that commonorderofϵ is constant on each one.  This checks that assertion.

commonorderofϵalreadybounded=Table[Union[Table[orderofϵ[mat],{mat,relevantweylgroup[[orbitpos[[alreadybounded[[co1]]]]]]}]],{co1,Length[alreadybounded]}]

commonorderofϵnotalreadybounded=Table[Union[Table[orderofϵ[mat],{mat,relevantweylgroup[[orbitpos[[notalreadybounded[[co1]]]]]]}]],{co1,Length[notalreadybounded]}]

commonorderofϵnonwall=Table[Union[Table[orderofϵ[mat],{mat,relevantweylgroup[[orbitpos[[nonwall[[co1]]]]]]}]],{co1,Length[nonwall]}]

commonorderofϵwall=Table[Union[Table[orderofϵ[mat],{mat,relevantweylgroup[[orbitpos[[wall[[co1]]]]]]}]],{co1,Length[wall]}]

Union[Length/@Join[commonorderofϵalreadybounded,commonorderofϵnotalreadybounded]]=={1}

Min[Flatten[commonorderofϵalreadybounded]]

This part is for the alreadybounded analysis

powertocheckto=15;exptemplate=Series[Exp[Sum[ToExpression["c"<>ToString[k]]ϵ^(k),{k,1,powertocheckto}]],{ϵ,0,powertocheckto}];

This makes a table of the exponents, outside constants, and the common order of ϵ for all relevant Weyl group elements that map to a particular already bounded orbit point.

This then looks at the higher coefficients (corresponding to ϵ^(commonorderofϵ + a nonnegative number called "power" here)).  It is supposed to show vanishing up to the order vanishingofalreadyboundedpartuntil.

vanishingofalreadyboundedpartuntil=3;

Table[coeflist=Table[tmp=exponent[mat];tmp2=CoefficientList[Series[tmp,{ϵ,0,powertocheckto}],ϵ];While[Length[tmp2]<powertocheckto+1,AppendTo[tmp2,0]];If[Total[tmp2]≠Normal[tmp],Print["coeflist formation violation"]];tmp2,{mat,relevantweylgroup[[orbitpos[[alreadybounded[[co1]]]]]]}];outsidelist=Table[outsideconstant[mat],{mat,relevantweylgroup[[orbitpos[[alreadybounded[[co1]]]]]]}];commonorderofϵ=commonorderofϵalreadybounded[[co1]];Table[testerlist=Expand[Simplify[SeriesCoefficient[exptemplate,{ϵ,0,power}]]];If[power==0,testerlist={1}];If[power==1,testerlist={c1}];If[testerlist≠Total[testerlist],Print["testerlist failure"]];Table[Print[{co1,Length[alreadybounded],power,vanishingofalreadyboundedpartuntil-commonorderofϵ[[1]],co,Length[testerlist]}];tester=testerlist[[co]];ParallelSum[If[Mod[k,50]==0,Print[{k,Length[outsidelist]}]];(tester/.c1->coeflist[[k,2]]/.c2->coeflist[[k,3]]/.c3->coeflist[[k,4]]/.c4->coeflist[[k,5]]/.c5->coeflist[[k,6]]/.c6->coeflist[[k,7]]/.c7->coeflist[[k,8]]/.c8->coeflist[[k,9]]/.c9->coeflist[[k,10]]/.c10->coeflist[[k,11]]/.c11->coeflist[[k,12]]/.c12->coeflist[[k,13]]/.c13->coeflist[[k,14]]/.c14->coeflist[[k,15]]/.c15->coeflist[[k,16]])outsidelist[[k]]//Expand,{k,Length[outsidelist]}],{co,1, Length[testerlist]}],{power,0,vanishingofalreadyboundedpartuntil-commonorderofϵ[[1]]}],{co1,1,Length[alreadybounded]}]

Flatten[%]//Union

We need at least one of these to not vanish to the next order :

Table[coeflist=Table[tmp=exponent[mat];tmp2=CoefficientList[Series[tmp,{ϵ,0,powertocheckto}],ϵ];While[Length[tmp2]<powertocheckto+1,AppendTo[tmp2,0]];If[Total[tmp2]≠Normal[tmp],Print["coeflist formation violation"]];tmp2,{mat,relevantweylgroup[[orbitpos[[alreadybounded[[co1]]]]]]}];outsidelist=Table[outsideconstant[mat],{mat,relevantweylgroup[[orbitpos[[alreadybounded[[co1]]]]]]}];commonorderofϵ=commonorderofϵalreadybounded[[co1]];Table[If[power≥0,testerlist=Expand[Simplify[SeriesCoefficient[exptemplate,{ϵ,0,power}]]];If[power==0,testerlist={1}];If[power==1,testerlist={c1}];If[testerlist≠Total[testerlist],Print["testerlist failure"]];Table[Print[{co1,power,co,Length[testerlist]}];tester=testerlist[[co]];ParallelSum[If[Mod[k,50]==0,Print[k]];(tester/.c1->coeflist[[k,2]]/.c2->coeflist[[k,3]]/.c3->coeflist[[k,4]]/.c4->coeflist[[k,5]]/.c5->coeflist[[k,6]]/.c6->coeflist[[k,7]]/.c7->coeflist[[k,8]]/.c8->coeflist[[k,9]]/.c9->coeflist[[k,10]]/.c10->coeflist[[k,11]]/.c11->coeflist[[k,12]]/.c12->coeflist[[k,13]]/.c13->coeflist[[k,14]]/.c14->coeflist[[k,15]]/.c15->coeflist[[k,16]])outsidelist[[k]]//Expand,{k,Length[outsidelist]}],{co,1, Length[testerlist]}]],{power,vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]],vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]]}],{co1,(* 1*) 1,Length[alreadybounded](*Length[alreadybounded]*)}]

Coefficient[%,t1 ]

This part is for the notalreadybounded-nonwall analysis

powertocheckto=15;exptemplate=Series[Exp[Sum[ToExpression["c"<>ToString[k]]ϵ^(k),{k,1,powertocheckto}]],{ϵ,0,powertocheckto}];

This does a similar analysis for the orbits off the wall, and shows they vanish to a higher order than the already bounded ones.

Table[coeflist=Table[tmp=exponent[mat];tmp2=CoefficientList[Series[tmp,{ϵ,0,powertocheckto}],ϵ];While[Length[tmp2]<powertocheckto+1,AppendTo[tmp2,0]];If[Total[tmp2]≠Normal[tmp],Print["coeflist formation violation"]];tmp2,{mat,relevantweylgroup[[orbitpos[[nonwall[[co1]]]]]]}];outsidelist=Table[outsideconstant[mat],{mat,relevantweylgroup[[orbitpos[[nonwall[[co1]]]]]]}];commonorderofϵ=commonorderofϵnonwall[[co1]];Table[testerlist=Expand[Simplify[SeriesCoefficient[exptemplate,{ϵ,0,power}]]];If[power==0,testerlist={1}];If[power==1,testerlist={c1}];If[testerlist≠Total[testerlist],Print["testerlist failure"]];Table[Print[{co1,Length[nonwall],power,vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]],co,Length[testerlist]}];tester=testerlist[[co]];ParallelSum[If[Mod[k,50]==0,Print[k]];(tester/.c1->coeflist[[k,2]]/.c2->coeflist[[k,3]]/.c3->coeflist[[k,4]]/.c4->coeflist[[k,5]]/.c5->coeflist[[k,6]]/.c6->coeflist[[k,7]]/.c7->coeflist[[k,8]]/.c8->coeflist[[k,9]]/.c9->coeflist[[k,10]]/.c10->coeflist[[k,11]]/.c11->coeflist[[k,12]]/.c12->coeflist[[k,13]]/.c13->coeflist[[k,14]]/.c14->coeflist[[k,15]]/.c15->coeflist[[k,16]])outsidelist[[k]]//Expand,{k,Length[outsidelist]}],{co,1, Length[testerlist]}],{power,0,vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]]}],{co1,1,Length[nonwall]}]

Flatten[%]//Union

This part is for the notalreadybounded - wall analysis

This first checks that the wall terms vanish to at least the same order as the already bounded ones.

powertocheckto=15;exptemplate=Series[Exp[Sum[ToExpression["c"<>ToString[k]]ϵ^(k),{k,1,powertocheckto}]],{ϵ,0,powertocheckto}];

Table[coeflist=Table[tmp=exponent[mat];tmp2=CoefficientList[Series[tmp,{ϵ,0,powertocheckto}],ϵ];While[Length[tmp2]<powertocheckto+1,AppendTo[tmp2,0]];If[Total[tmp2]≠Normal[tmp],Print["coeflist formation violation"]];tmp2,{mat,relevantweylgroup[[orbitpos[[wall[[co1]]]]]]}];outsidelist=Table[outsideconstant[mat],{mat,relevantweylgroup[[orbitpos[[wall[[co1]]]]]]}];commonorderofϵ=commonorderofϵwall[[co1]];Table[testerlist=Expand[Simplify[SeriesCoefficient[exptemplate,{ϵ,0,power}]]];If[power==0,testerlist={1}];If[power==1,testerlist={c1}];If[testerlist≠Total[testerlist],Print["testerlist failure"]];Table[Print[{co1,Length[wall],power,vanishingofalreadyboundedpartuntil-commonorderofϵ[[1]],co,Length[testerlist]}];tester=testerlist[[co]];ParallelSum[If[Mod[k,50]==0,Print[k]];(tester/.c1->coeflist[[k,2]]/.c2->coeflist[[k,3]]/.c3->coeflist[[k,4]]/.c4->coeflist[[k,5]]/.c5->coeflist[[k,6]]/.c6->coeflist[[k,7]]/.c7->coeflist[[k,8]]/.c8->coeflist[[k,9]]/.c9->coeflist[[k,10]]/.c10->coeflist[[k,11]]/.c11->coeflist[[k,12]]/.c12->coeflist[[k,13]]/.c13->coeflist[[k,14]]/.c14->coeflist[[k,15]]/.c15->coeflist[[k,16]])outsidelist[[k]]//Expand,{k,Length[outsidelist]}],{co,1, Length[testerlist]}],{power,0,vanishingofalreadyboundedpartuntil-commonorderofϵ[[1]]}],{co1,1,Length[wall]}]

Flatten[%]//Union

Next we see if this vanishing goes further:

Table[coeflist=Table[tmp=exponent[mat];tmp2=CoefficientList[Series[tmp,{ϵ,0,powertocheckto}],ϵ];While[Length[tmp2]<powertocheckto+1,AppendTo[tmp2,0]];If[Total[tmp2]≠Normal[tmp],Print["coeflist formation violation"]];tmp2,{mat,relevantweylgroup[[orbitpos[[wall[[co1]]]]]]}];outsidelist=Table[outsideconstant[mat],{mat,relevantweylgroup[[orbitpos[[wall[[co1]]]]]]}];commonorderofϵ=commonorderofϵwall[[co1]];Table[If[power≥0,testerlist=Expand[Simplify[SeriesCoefficient[exptemplate,{ϵ,0,power}]]];If[power==0,testerlist={1}];If[power==1,testerlist={c1}];If[testerlist≠Total[testerlist],Print["testerlist failure"]];Table[Print[{co1,Length[wall],power,vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]],co,Length[testerlist]}];tester=testerlist[[co]];ParallelSum[If[Mod[k,50]==0,Print[k]];(tester/.c1->coeflist[[k,2]]/.c2->coeflist[[k,3]]/.c3->coeflist[[k,4]]/.c4->coeflist[[k,5]]/.c5->coeflist[[k,6]]/.c6->coeflist[[k,7]]/.c7->coeflist[[k,8]]/.c8->coeflist[[k,9]]/.c9->coeflist[[k,10]]/.c10->coeflist[[k,11]]/.c11->coeflist[[k,12]]/.c12->coeflist[[k,13]]/.c13->coeflist[[k,14]]/.c14->coeflist[[k,15]]/.c15->coeflist[[k,16]])outsidelist[[k]]//Expand,{k,Length[outsidelist]}],{co,1, Length[testerlist]}]],{power,vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]],vanishingofalreadyboundedpartuntil+1-commonorderofϵ[[1]]}],{co1,1,Length[wall]}]

Union[Flatten[%]]

%149[[2]]

Coefficient[%, -8 (t1^3) t2]

orbitpos[[wall[[-7]]]]

relevantweylgroup[[orbitpos[[wall[[1]]]]]]//Simplify

Table[%[[k]].λtostudy,{k,Length[%]}]//Union

%.Transpose[simproots]//Simplify

λtostudy.Transpose[simproots]//Simplify

Position[relevantweyltranslates,λtostudy]