Loop group methods for the non-abelian Hodge correspondence

This files documents the computations in Section 6 of the paper Loop group methods for the non-abelian Hodge correspondence on a 4-punctured sphere, by Lynn Heller, Sebastian Heller & Martin Traizet. Equations numbers refer to the paper.

Ω - integrals

Omega[{i1,...ik}] denotes Ω_{i1,...,ik}(1)
Theta[{i1,...,ik}] denotes Ω_{i1,...,ik}(i)

Some elementary Ω-integrals

elementaryOmega={Omega[{3}]-> I Pi,Theta[{2}]-> - I Pi,Omega[{i_,i_}]->Omega[{i}]^2/2,Omega[{i_,i_,i_}]->Omega[{i}]^3/6,Theta[{i_,i_}]->Theta[{i}]^2/2,Theta[{i_,i_,i_}]->Theta[{i}]^3/6}

Explicit formulas in the case p=Exp[i Pi/4] from the appendix of [26] by Steven Charlton

log[2] =Log[2] is kept formal to avoid pointless simplifications by Mathematica

explicitOmega={Omega[{3}]->I π,Omega[{2,1}]->-I π log[2],Omega[{2,2,3}]->((I (π^3))/12),Omega[{3,1,1}]->-((I (π^3))/12)+(1/2) I π ((log[2])^2),Omega[{2,1,1,1}]->(1/12) I (π^3) log[2]-(1/6) I π ((log[2])^3)-(1/4) I π zeta[3],Omega[{2,1,3,3}]->(1/4) I (π^3) log[2]-I π zeta[3],Omega[{2,2,2,1}]->-(1/12) I (π^3) log[2]+(1/4) I π zeta[3],Omega[{3,1,2,3}]->-(1/4) I (π^3) log[2]+(13/8) I π zeta[3],Omega[{3,3,2,1}]->(1/6) I (π^3) log[2]-(5/8) I π zeta[3]}

Simplification of Theta integrals in case p=Exp[i Pi/4]

tau[1]=1;tau[2]=3;tau[3]=2;
explicitTheta={Theta[{i_}]->(-1)^tau[i] Omega[{tau[i]}],Theta[{i_,j_}]->(-1)^(tau[i]+tau[j])Omega[{tau[i],tau[j]}],Theta[{i_,j_,k_}]->(-1)^(tau[i]+tau[j]+tau[k])Omega[{tau[i],tau[j],tau[k]}],
Theta[{i_,j_,k_,l_}]->(-1)^(tau[i]+tau[j]+tau[k]+tau[l])Omega[{tau[i],tau[j],tau[k],tau[l]}]}

Numerical evaluation of Omega integrals

The following file contains two substitution rules numOmega and numOmega2 which contains all Omega and Theta values for respectively p=0.8 + 0.9 I and p=1.2 + 1.1 I and depth at most 3. Used to verify that some identities are true numerically. These values were computed using the built-in Multipolylog function in Maple. See Appendix of [26] on how to express Omega-integrals in term of Multipolylogs.

<< "mathematica/higgs/numOmega.txt";

(You need to change the above path to wherever the companion file numOmega.txt is)

Omega[{1}]Omega[{2}]-(Omega[{1,2}]+Omega[{2,1}])/.numOmega

Theta[{1,2}]Theta[{3}]-(Theta[{1,2,3}]+Theta[{1,3,2}]+Theta[{3,1,2}])/.numOmega2

Shuffle relations (see Appendix of [26])

prep[i_,l_]:=Table[Prepend[l[[jj]],i],{jj,1,Length[l]}]
shufflefct[a_List,b_List]:=If[Length[b]==0,{a},If[Length[a]==0,{b},Join[prep[First[a],shufflefct[Rest[a],b]],prep[First[b],shufflefct[a,Rest[b]]]]]]
shuffleOmega[l1_List,l2_List]:=(s=shufflefct[l1,l2];Sum[Omega[s[[jj]]],{jj,1,Length[s]}])
shuffleTheta[l1_List,l2_List]:=(s=shufflefct[l1,l2];Sum[Theta[s[[jj]]],{jj,1,Length[s]}])

shuffle2={Omega[{i_}]Omega[{j_}]->shuffleOmega[{i},{j}],Theta[{i_}]Theta[{j_}]->shuffleTheta[{i},{j}],Conjugate[Omega[{i_}]]Conjugate[Omega[{j_}]]->Conjugate[shuffleOmega[{i},{j}]],Conjugate[Theta[{i_}]]Conjugate[Theta[{j_}]]->Conjugate[shuffleTheta[{i},{j}]]}

shuffle3={Omega[{i_}]Omega[{j_,k_}]->shuffleOmega[{i},{j,k}],Theta[{i_}]Theta[{j_,k_}]->shuffleTheta[{i},{j,k}],Conjugate[Omega[{i_}]]Conjugate[Omega[{j_,k_}]]->Conjugate[shuffleOmega[{i},{j,k}]],Conjugate[Theta[{i_}]]Conjugate[Theta[{j_,k_}]]->Conjugate[shuffleTheta[{i},{j,k}]]}

shuffle4={Omega[{i_}]Omega[{j_,k_,l_}]->shuffleOmega[{i},{j,k,l}],Omega[{i_,j_}]Omega[{k_,l_}]->shuffleOmega[{i,j},{k,l}],
Conjugate[Omega[{i_}]]Conjugate[Omega[{j_,k_,l_}]]->Conjugate[shuffleOmega[{i},{j,k,l}]],Conjugate[Omega[{i_,j_}]]Conjugate[Omega[{k_,l_}]]->Conjugate[shuffleOmega[{i,j},{k,l}]],
Theta[{i_}]Theta[{j_,k_,l_}]->shuffleTheta[{i},{j,k,l}],Theta[{i_,j_}]Theta[{k_,l_}]->shuffleTheta[{i,j},{k,l}],
Conjugate[Theta[{i_}]]Conjugate[Theta[{j_,k_,l_}]]->Conjugate[shuffleTheta[{i},{j,k,l}]],Conjugate[Theta[{i_,j_}]]Conjugate[Theta[{k_,l_}]]->Conjugate[shuffleTheta[{i,j},{k,l}]]
}

shuffle=Union[shuffle2,shuffle3,shuffle4];

The following rule is sometimes used to simplify complex Omega integrals

complexOmega={Omega[{i_}]->Re[Omega[{i}]]+I Im[Omega[{i}]],Omega[{i_,j_}]->Re[Omega[{i,j}]]+I Im[Omega[{i,j}]],Omega[{i_,j_,k_}]->Re[Omega[{i,j,k}]]+I Im[Omega[{i,j,k}]],Theta[{i_}]->Re[Theta[{i}]]+I Im[Theta[{i}]],Theta[{i_,j_}]->Re[Theta[{i,j}]]+I Im[Theta[{i,j}]],Theta[{i_,j_,k_}]->Re[Theta[{i,j,k}]]+I Im[Theta[{i,j,k}]]}

Parameters

uc = Conjugate[u]
vc = Conjugate[v]   (used as formal variables to compute partial derivatives)
x[i] represents parameter x_i
x[i,n] represents nth order t-derivative x[i]^(n) at t=0,  for  i=1,2,3
a[n,k] represents coefficient of lambda^k in a^(n)=x[1]^(n) at t=0
b[n,k] represents coefficient of lambda^k in b^(n)=x[2]^(n) at t=0
c[n,k] represents coefficients of lambda^k in c^(n)=x[3]^(n) at t=0

nmax=4

evalrho={rho->Sqrt[1+1/(u uc + v vc)^2]};

rho is kept as a formal variable. One must not forget to do the substitution rule evalrho before compute partial derivatives with respect to u, uc, v, vc.

a[0,-1]=u v;b[0,-1]= 1/2(v^2-u^2);c[0,-1]=I/2(u^2+v^2);

a[0,0]=rho (u uc-v vc);b[0,0]=rho (u vc+v uc);c[0,0]=rho (u vc-v uc)/I;

a[0,1]=-uc vc;
b[0,1]=-1/2(vc^2-uc^2);
c[0,1]=I/2(uc^2+vc^2);

x[1,0]=a[0,-1]/lambda+a[0,0]+a[0,1]lambda;x[2,0]=b[0,-1]/lambda+b[0,0]+b[0,1]lambda;
x[3,0]=c[0,-1]/lambda+c[0,0]+c[0,1]lambda;

Do[x[1,n]=Sum[a[n,k]lambda^k,{k,0,n+1}];x[2,n]=Sum[b[n,k]lambda^k,{k,0,n+1}];x[3,n]=Sum[c[n,k]lambda^k,{k,0,n+1}],{n,1,nmax}]

Do[x[j]=Sum[x[j,n] t^n/Factorial[n],{n,0,nmax}],{j,1,3}]

Unprotect[Conjugate];

Conjugate[rho]=rho;Conjugate[u]=uc;Conjugate[uc]=u;Conjugate[v]=vc;Conjugate[vc]=v;
Conjugate[log[2]]=log[2];
Conjugate[zeta[3]]=zeta[3];

Conjugate[a_+b_]=Conjugate[a]+Conjugate[b];Conjugate[a_ b_]=Conjugate[a]Conjugate[b];

Renormalized energy

The following is the renormalized energy : Equation (110)

Energy=-8 Pi ( 1+ I/Coefficient[x[1],lambda,-1](-Coefficient[x[2],lambda,-1]Coefficient[ x[3],lambda,0]+Coefficient[x[3],lambda,-1]Coefficient[x[2],lambda,0] ))

Check formula for energy at t=0 : Equation (111)

Simplify[Energy/.{t->0}]

Rescaled twisted holomorphic symplectic form ω

omega[n,k,X,Y] is the coefficient of lambda^k  Wedge[dX,dY] in the n-th order t-derivative of ω  at t=0.
X,Y  should be either u,v,uc or vc.
d is used as a symbol for (delayed) differentiation with respect to X,Y.
To evaluate ω:
- substitute the derivatives of the parameters as functions of u,uc,v,vc and rho
- substitute evalrho to express rho as a function of u,uc,v,vc
- substitute d->D to compute the derivatives with respect to X,Y

db[X_]:=D[b[0,-1],X]/lambda + Sum[Sum[d[b[n,k],X]lambda^k t^n/Factorial[n],{k,0,n+1}],{n,0,nmax-1}]

dc[X_]:=D[c[0,-1],X]/lambda +Sum[Sum[d[c[n,k],X]lambda^k t^n/Factorial[n],{k,0,n+1}],{n,0,nmax-1}]

aa=a[0,-1]/lambda +Sum[Sum[a[n,k]lambda^k t^n/Factorial[n],{k,0,n+1}],{n,0,nmax-1}];

om[X_,Y_]:=(db[X] dc[Y]-db[Y]dc[X])/aa;

omega[n_,k_,X_,Y_]:=Coefficient[Series[(D[om[X,Y],{t,n}]/.{t->0}),{lambda,0,n+1}],lambda,k]

Check formulas for omega at t=0 : Equation (91)

omega[0,-1,u,v]/.evalrho/.{d->D}

omega[0,1,uc,vc]/.evalrho/.{d->D}//Simplify

omega[0,0,u,uc]/.evalrho/.{d->D}//Simplify

Simplify[%+2 I (r^6+v vc)/(rho r^6)/.evalrho/.{r->Sqrt[u uc + v vc]}]

omega[0,0,u,vc]/.evalrho/.{d->D}//Simplify

omega[0,0,uc,v]/.evalrho/.{d->D}//Simplify

omega[0,0,v,vc]/.evalrho/.{d->D}//Simplify

Simplify[%+ 2  I (r^6+u uc)/(rho r^6)/.evalrho/.{r->Sqrt[u uc + v vc]}]

Algorithm to compute t-derivatives of parameters at t=0

deriv[n,subs] computes nth order derivatives of parameters, simplifies using subs  and returns a list of substitutions rules a[n,k]-> ...
(The algorithm is explained in section 6)
Here subs is used to restrict to particular cases. It is much simpler to do the substitution before computing the derivatives than after.

m[1]={{1,0},{0,-1}}; m[2]={{0,1},{1,0}}; m[3]={{0,I},{-I,0}};

prodm[l_]:=prodm[l]=If[Length[l]==1,m[First[l]],m[First[l]].prodm[Rest[l]]]

irange[n_]:=irange[n]=If[n==1,{{1},{2},{3}},Flatten[Map[Function[l,{Append[l,1],Append[l,2],Append[l,3]}],irange[n-1]],1]]

pos[f_]:=Sum[Coefficient[f,lambda^k]lambda^k,{k,1,Exponent[f,lambda]}]

neg[f_]:=Sum[Coefficient[f,lambda^k]lambda^k,{k,-Exponent[f,1/lambda],-1}]

star[f_]:=Sum[Conjugate[Coefficient[f,lambda,k]](-lambda)^(-k),{k,-Exponent[f,1/lambda],Exponent[f,lambda]}]

Expand[{star[x[1,0]]-x[1,0],star[x[2,0]]-x[2,0],star[x[3,0]-x[3,0]]}]

derivprodx[l_,n_]:=If[Length[l]==1,x[First[l],n],
Sum[Binomial[n,k]x[First[l],k]derivprodx[Rest[l],n-k],{k,0,n}]]

Plower[n_]:={{0,0},{0,0}}+Sum[(Factorial[n]/Factorial[n-l])Sum[derivprodx[irange[l][[j]],n-l]prodm[irange[l][[j]]]Omega[irange[l][[j]]],{j,1,3^l}],{l,2,n}]

Qlower[n_]:={{0,0},{0,0}}+Sum[(Factorial[n]/Factorial[n-l])Sum[derivprodx[irange[l][[j]],n-l]prodm[irange[l][[j]]]Theta[irange[l][[j]]],{j,1,3^l}],{l,2,n}]

P[n_]:=If[n==0,{{1,0},{0,1}},Plower[n]+n Sum[x[i,n-1] m[i]Omega[{i}],{i,1,3}]]

Q[n_]:=If[n==0,{{1,0},{0,1}},Qlower[n]+n Sum[x[i,n-1] m[i]Theta[{i}],{i,1,3}]]

p,q represent \mathcal p, \mathcal q in the paper

plower[n_]:=Sum[Binomial[n,k] (P[k][[1,1]]P[n-k][[2,1]]-P[k][[1,2]]P[n-k][[2,2]]),{k,1,n-1}]+Plower[n][[2,1]]-Plower[n][[1,2]]

qlower[n_]:=Sum[I Binomial[n,k] (Q[k][[1,1]]Q[n-k][[2,1]]+Q[k][[1,2]]Q[n-k][[2,2]]),{k,1,n-1}]+I Qlower[n][[2,1]]+I Qlower[n][[1,2]]

p[n_]:=plower[n]+2 Pi n x[3,n-1]

q[n_]:=qlower[n]+2 Pi n x[2,n-1]

Klower[n_]:=Sum[Binomial[n,k]Sum[x[i,k]x[i,n-k],{i,1,3}],{k,1,n-1}]

K[n_]:=Klower[n]+2 Sum[x[i,0] x[i,n],{i,1,3}]

deriv[n_,subs_]:=(pl=Expand[(star[plower[n+1]]-plower[n+1])/(2 Pi (n+1))];ql=Expand[( star[qlower[n+1]]-qlower[n+1])/(2 Pi (n+1))];
Print["computing positive part of c^(n)"];
cpos[n]=Simplify[pos[pl]//.subs];
Print["computing positive part of b^(n)"];
bpos[n]=Simplify[pos[ql]//.subs];
kl=Klower[n];
Print["computing positive part of a^(n)"];
apos[n]=Simplify[pos[PolynomialQuotient[-lambda(kl/2+x[2,0] bpos[n]+x[3,0] cpos[n]),lambda x[1,0],lambda]]//.subs];
eq=kl/2+
(a[n,0]+apos[n])  x[1,0]+
(b[n,0]+bpos[n])  x[2,0]+
(c[n,0]+cpos[n])  x[3,0];
Print["solving system"];
sol=Solve[Table[Coefficient[eq,lambda,k]==0,{k,-1,1}],{a[n,0],b[n,0],c[n,0]}];
Print["simplify solution"];
sol=Simplify[sol//.subs];
Print["done"];
Flatten[Join[Table[{a[n,k]->Coefficient[apos[n],lambda,k],b[n,k]->Coefficient[bpos[n],lambda,k],c[n,k]->Coefficient[cpos[n],lambda,k]},{k,1,n+1}],sol]])

Computation in the most symmetric case p=Exp[I Pi/4] + nilpotent cone

The Omega-integrals are explicitly known and we take v = Exp[I Pi/4] u

nilpotentCone={v-> (1+I)/Sqrt[2] u,vc->(1-I)/Sqrt[2] uc}

deriv1symc=deriv[1,Union[shuffle,explicitTheta,explicitOmega,nilpotentCone]]

deriv2symc=deriv[2,Union[shuffle,explicitTheta,explicitOmega,elementaryOmega,nilpotentCone,deriv1symc]]

deriv3symc=deriv[3,Union[shuffle,explicitTheta,explicitOmega,elementaryOmega,nilpotentCone,deriv1symc,deriv2symc]]

Renormalized energy

First order derivative

D[Energy,t]/.{t->0}/.deriv1symc/.nilpotentCone//Simplify

Second order derivative

D[Energy,t,t]/.{t->0}/.deriv2symc/.nilpotentCone//Simplify

Third order derivative: Equation (117)

D[Energy,t,t,t]/.{t->0}/.deriv3symc/.evalrho/.nilpotentCone//Simplify

Rescaled twisted holomorphic symplectic form ω

First order derivative

omega[1,0,u,uc]/.deriv1symc/.evalrho/.nilpotentCone/.{d->D}

Second order derivative

omega[2,0,u,uc]/.deriv2symc/.deriv1symc/.evalrho/.nilpotentCone/.{d->D}

Equation (118)

omega[3,0,u,uc]/.deriv3symc/.deriv2symc/.deriv1symc/.evalrho/.nilpotentCone/.{d->D}//Simplify

Computation in the most symmetric case p=Exp[I Pi/4]

The Omega-integrals are explictly known, but u,v are arbitrary

deriv1sym=deriv[1,Union[shuffle,explicitTheta,explicitOmega,elementaryOmega]]

deriv2sym=deriv[2,Union[shuffle,explicitTheta,explicitOmega,elementaryOmega,deriv1sym]]

deriv3sym=deriv[3,Union[shuffle,explicitTheta,explicitOmega,elementaryOmega,deriv2sym,deriv1sym]];

Renormalized energy

First order derivative: Equation (113)

D[Energy,t]/.{t->0}/.deriv1sym//Simplify

Second order derivative: Equation (116)

D[Energy,t,t]/.{t->0}/.deriv2sym/.evalrho//Simplify

Simplify[(%-32 Pi ( u uc - v vc)^2(3 r^8+2 r^4+4 u uc v vc)log[2]^2/(rho r^6))/.evalrho/.{r-> Sqrt[u uc + v vc]}]

Third order derivative (formula not in the paper)

D[Energy,t,t,t]/.{t->0}/.deriv3sym/.evalrho//Simplify

Rescaled twisted holomorphic symplectic form ω

First order derivative (formulas not in the paper)

omega[1,0,u,v]/.deriv1sym/.evalrho/.{d->D}//Simplify

omega[1,0,u,uc]/.deriv1sym/.evalrho/.{d->D}//Simplify

omega[1,0,u,vc]/.deriv1sym/.evalrho/.{d->D}//Simplify

omega[1,0,uc,v]/.deriv1sym/.evalrho/.{d->D}//Simplify

omega[1,0,uc,vc]/.deriv1sym/.evalrho/.{d->D}//Simplify

omega[1,0,v,vc]/.deriv1sym/.evalrho/.{d->D}//Simplify

Computation in the general case

First order derivative

deriv1=deriv[1,shuffle];

check equations are solved

Simplify[K[1]/.deriv1]

Simplify[(p[1]/.deriv1)-star[p[1]/.deriv1]]

Simplify[(q[1]/.deriv1)-star[q[1]/.deriv1]]

check with theoretical result (proposition 70)

xpostheo[1]=2 /Pi (Omega[{2,1}]+Theta[{3,1}]-Conjugate[Omega[{2,1}]+Theta[{3,1}]])pos[x[2,0]x[3,0]];xpostheo[2]=-2 /Pi (Theta[{3,1}]-Conjugate[Theta[{3,1}]])pos[x[1,0]x[3,0]];
xpostheo[3]=-2 /Pi (Omega[{2,1}]-Conjugate[Omega[{2,1}]])pos[x[1,0]x[2,0]];

Xtheo=Sum[Coefficient[x[j,0],lambda,-1]Coefficient[xpostheo[j],lambda,1],{j,1,3}];Ytheo=Sum[Coefficient[x[j,0],lambda,-1]Coefficient[xpostheo[j],lambda,2]+Coefficient[x[j,0],lambda,0]Coefficient[xpostheo[j],lambda,1],{j,1,3}];

xtheo[1]=Simplify[xpostheo[1]-1/(rho(u uc+v vc)^2)((u uc -v vc)Xtheo-2 rho u v Ytheo)];
xtheo[2]=Simplify[xpostheo[2]-1/(rho(u uc+v vc)^2)((u vc+ uc v)Xtheo-rho (v^2-u^2) Ytheo)];
xtheo[3]=Simplify[xpostheo[3]-1/(rho(u uc+v vc)^2)((u vc-uc v)/I Xtheo-I rho (u^2+v^2) Ytheo)];

Table[Simplify[(x[j,1]/.deriv1)-xtheo[j]],{j,1,3}]

Renormalized energy

First order derivative: Equation (112)

D[Energy,t]/.{t->0}/.deriv1/.complexOmega//Simplify

Rescaled twisted holomorphic symplectic form ω

First order derivative : Equation (107)

omega[1,0,u,v]/.deriv1/.evalrho/.{d->D}//Simplify

omega[1,0,uc,vc]/.deriv1/.evalrho/.{d->D}//Simplify

Coefficient of Wedge[du, duc]

omega[1,0,u,uc]/.deriv1/.evalrho/.{d->D}/.complexOmega//Simplify

Check with theoretical result

Simplify[%-(4I/Pi/r^8 Im[Omega[{2,1}]]((-r^4+3(uc v+u vc)^2)v vc+r^8(u uc -v vc))+ 4I/Pi /r^8 Im[Theta[{3,1}]]((r^4+3(uc v - u vc)^2)v vc+r^8(v vc-u uc)))/.{r->Sqrt[u uc + v vc]}]

Coefficient of Wedge[du, dvc]

omega[1,0,u,vc]/.deriv1/.evalrho/.{d->D}/.complexOmega//Simplify

Check with theoretical result

Simplify[%-(4 I/Pi/r^8 Im[Omega[{2,1}]]((r^4-3(uc v+u vc)^2)uc v+r^8(-uc v -3u vc))+4 I/Pi /r^8 Im[Theta[{3,1}]]((-r^4-3(uc v - u vc)^2)uc v+r^8(uc v-3u vc)))/.{r->Sqrt[u uc + v vc]}]

omega[1,0,v,uc]/.deriv1/.evalrho/.{d->D}/.complexOmega//Simplify

Simplify[%-(4 I/Pi/r^8 Im[Omega[{2,1}]]((r^4-3(uc v+u vc)^2)u vc+r^8(-u vc -3uc v))+4 I /Pi/r^8 Im[Theta[{3,1}]]((-r^4-3(uc v - u vc)^2)u vc+r^8(u vc-3uc v)))/.{r->Sqrt[u uc + v vc]}]

omega[1,0,v,vc]/.deriv1/.evalrho/.{d->D}/.complexOmega//Simplify

Simplify[%-(4 I/Pi/r^8 Im[Omega[{2,1}]]((-r^4+3(uc v+u vc)^2)u uc+r^8(v vc- u uc))+4 I/Pi /r^8 Im[Theta[{3,1}]]((r^4+3(uc v - u vc)^2)u uc+r^8(u uc-v vc)))/.{r->Sqrt[u uc + v vc]}]

Second order derivative

deriv2=deriv[2,shuffle];

check equations are solved

Simplify[K[2]/.deriv2]

Simplify[(p[2]/.deriv2/.deriv1)-star[p[2]/.deriv2/.deriv1]]//.shuffle

Simplify[(q[2]/.deriv2/.deriv1)-star[q[2]/.deriv2/.deriv1]]//.shuffle

New Omega-identities from ω’’

(section 7.3)

omega[2,0,uc,vc]

d2omega0uv=omega[2,0,u,v]/.deriv2/.deriv1/.evalrho/.{d->D};

Mathematica gets lost in the simplification of d2omega0uv so let’s help a little bit

O311=Coefficient[d2omega0uv,Omega[{3,1,1}]]//Simplify

O223=Coefficient[d2omega0uv,Omega[{2,2,3}]]//Simplify

O333=Coefficient[d2omega0uv,Omega[{3,3,3}]]//Simplify

T211=Coefficient[d2omega0uv,Theta[{2,1,1}]]//Simplify

T332=Coefficient[d2omega0uv,Theta[{3,3,2}]]//Simplify

T222=Coefficient[d2omega0uv,Theta[{2,2,2}]]//Simplify

O21O21=Coefficient[d2omega0uv,Omega[{2,1}]^2]//Simplify

T31T31=Coefficient[d2omega0uv,Theta[{3,1}]^2]//Simplify

O21T31=Coefficient[d2omega0uv,Omega[{2,1}]Theta[{3,1}]]//Simplify

newd2omega0uv=O311 (Omega[{3,1,1}]+Conjugate[Omega[{3,1,1}]])+O223 (Omega[{2,2,3}]+Conjugate[Omega[{2,2,3}]])+O333 (Omega[{3,3,3}]+Conjugate[Omega[{3,3,3}]])+ T211 (Theta[{2,1,1}]+Conjugate[Theta[{2,1,1}]])+T332 (Theta[{3,3,2}]+Conjugate[Theta[{3,3,2}]])+T222 (Theta[{2,2,2}]+Conjugate[Theta[{2,2,2}]])+O21O21(Omega[{2,1}]^2-Conjugate[Omega[{2,1}]]^2)+T31T31(Theta[{3,1}]^2-Conjugate[Theta[{3,1}]]^2)+O21T31(Omega[{2,1}]Theta[{3,1}]-Conjugate[Omega[{2,1}]Theta[{3,1}]]);

Check we have all terms

Expand[d2omega0uv]-newd2omega0uv//Simplify

I1=6 Pi (Omega[{3,3,3}]-Theta[{2,2,2}])+I (Omega[{2,1}]^2+Theta[{3,1}]^2)+2 Pi(Omega[{2,2,3}]-Theta[{3,3,2}])-8 Pi(Omega[{3,1,1}]-Theta[{2,1,1}])+10 I Omega[{2,1}]Theta[{3,1}]

I2=I(Omega[{2,1}]^2-Theta[{3,1}]^2)+2 Pi(Omega[{2,2,3}]+Theta[{3,3,2}]+Omega[{3,1,1}]+Theta[{2,1,1}])-4 Pi (Omega[{3,3,3}]+Theta[{2,2,2}])

I3=-I(Omega[{2,1}]^2+Theta[{3,1}]^2)-2 Pi (Omega[{2,2,3}]-Theta[{3,3,2}])+2 Pi (Omega[{3,3,3}]-Theta[{2,2,2}])-2 I Omega[{2,1}]Theta[{3,1}]

Equation (119)

Simplify[newd2omega0uv-rho/Pi^2 (6 (u uc^2 vc-uc v vc^2)(I1+Conjugate[I1])+8(uc^3v -u vc^3)(I2+Conjugate[I2])+(u uc^6/vc^3-v vc^6/uc^3+ 3uc^5 v/vc^2-3 u vc^5/uc^2)(I3+Conjugate[I3]))/.evalrho]/.elementaryOmega/.elementaryOmega

I1=I1/.elementaryOmega;I2=I2/.elementaryOmega;I3=I3/.elementaryOmega

i1=I1/.explicitTheta/.explicitOmega//Simplify

i2=I2/.explicitTheta/.explicitOmega//Simplify

i3=I3/.explicitTheta/.explicitOmega//Simplify

newIdentities=Solve[{I1==i1,I2==i2,I3==i3}][[1]]

Equation (120)

id1=Omega[{2,2,3}]+Omega[{3,1,1}]+I/(2 Pi)Omega[{2,1}]^2

id2=Theta[{2,1,1}]+Theta[{3,3,2}]-I/(2 Pi) Theta[{3,1}]^2

id3=Omega[{2,2,3}]-Theta[{3,3,2}]+I/(2 Pi) (Omega[{2,1}]+Theta[{3,1}])^2-I Pi^3/6

{id1,id2,id3}/.newIdentities/.elementaryOmega//Simplify

Check identities  numerically for some choices of p

{id1,id2,id3}/.numOmega

{id1,id2,id3}/.numOmega2

Omega-identities by taking t-derivatives of Fricke equation

(See Remark 72)

r[n] computes the n-th order t-derivative of the quantity \mathfrak r in the paper.

rlower[n_]:= I(Plower[n][[2,2]]-Plower[n][[1,1]]+Qlower[n][[1,1]]-Qlower[n][[2,2]])+I Sum[Sum[(-1)^i (P[0][[2,i]]Q[0][[1,j]]+P[0][[1,i]]Q[0][[2,j]])Sum[Binomial[n,k] (P[n-k][[2,i]]Q[k][[1,j]]+P[n-k][[1,i]]Q[k][[2,j]]),{k,1,n-1}],{j,1,2}],{i,1,2}]+I/2Sum[Sum[Sum[(-1)^i Binomial[n,k]Sum[Binomial[n-k,l1](P[n-k-l1][[2,i]]Q[l1][[1,j]]+P[n-k-l1][[1,i]]Q[l1][[2,j]]),{l1,0,n-k}]Sum[Binomial[k,l2](P[k-l2][[2,i]]Q[l2][[1,j]]+P[k-l2][[1,i]]Q[l2][[2,j]]),{l2,0,k}],{k,1,n-1}],{j,1,2}],{i,1,2}]

r[n_]:=rlower[n]+2 Pi n x[1,n-1]

pp=Sum[p[n] t^n/Factorial[n],{n,0,nmax}];

qq=Sum[q[n] t^n/Factorial[n],{n,0,nmax}];

rr=Sum[r[n] t^n/Factorial[n],{n,0,nmax}];

Equation (103)

fricke=4 Cos[2 Pi t]^2+4 (pp^2+qq^2+rr^2-1)+8 pp qq rr;

The first two derivatives give nothing interesting :

fricke/.{t->0}

D[fricke,t]/.{t->0}

D[fricke,{t,2}]/.{t->0}/.evalrho//Simplify

Computations are greatly simplified by restricting to v=u, and we still get interesting identities

restrict={v->u,vc->uc}

The third order derivative gives the identity (104)

(D[fricke,{t,3}]/.{t->0}/.deriv1/.restrict/.evalrho//Simplify//Expand)/.shuffle/.elementaryOmega//Simplify

id4=Omega[{2,1}]-Omega[{2,3}]+Theta[{3,1}]-Theta[{3,2}]

Check identity numerically

id4/.numOmega

id4/.numOmega2

newidentity={Theta[{3,2}]->Omega[{2,1}]+Theta[{3,1}]-Omega[{2,3}]}

The 4th order derivative gives other identities (last paragraph of the paper)

d4fricke=D[fricke,{t,4}]/.{t->0}/.deriv2/.deriv1/.evalrho/.restrict//Expand;

Do[EQ[i]=Coefficient[d4fricke,lambda,i],{i,-4,4}]

EQ[4]/.numOmega2

eq1=Coefficient[EQ[4],uc^8]/(768 I Pi)/.shuffle2/.newidentity//.elementaryOmega//Expand

EQ[2]/.numOmega2

eq2=Coefficient[EQ[2],uc^4]/(768 I Pi)/.shuffle2/.newidentity//.elementaryOmega//Expand

EQ[0]/.numOmega2

eq3=Coefficient[EQ[0],u^2 uc^2]/(2 768 I Pi)/.shuffle2/.newidentity//.elementaryOmega//Expand

sol=Solve[{eq1==0,eq2==0,eq3==0},{Theta[{2,2,1}],Theta[{3,3,1}],Theta[{3,3,2}]}][[1]]

Check we don’t get more equations by picking other terms in EQ

Table[EQ[i],{i,-4,4}]/.shuffle2/.newidentity/.sol//.Union[elementaryOmega,{Theta[{1}]->Omega[{1}]-Pi I}]//Simplify

Rewrite the solution in a more pleasant form using shuffle relations

killDepth2={Omega[{i_}]->0,Theta[{i_}]->0,Omega[{i_,j_}]->0,Theta[{i_,j_}]->0}

Theta[{2,2,1}]/.sol/.killDepth2

Theta[{3,3,1}]/.sol/.killDepth2

Theta[{3,3,2}]/.sol/.killDepth2

We obtain three identities ID1=0, ID2=0 and ID3=0 which are Equations (121), (122) and (123) in the paper :

ID1=(Theta[{1}]Theta[{2,2}]+Theta[{2}]Theta[{1,1}]-Omega[{1}]Omega[{2,2}]/.shuffle/.sol)/2-(Theta[{1}]Theta[{2,2}]+Theta[{2}]Theta[{1,1}]-Omega[{1}]Omega[{2,2}])/2/.elementaryOmega//Expand

ID1/.numOmega

ID1/.numOmega2

ID2=(Theta[{1}]Theta[{3,3}]-Omega[{3}]Omega[{1,1}]-Omega[{1}]Omega[{3,3}]/.shuffle/.sol)/2-(Theta[{1}]Theta[{3,3}]-Omega[{3}]Omega[{1,1}]-Omega[{1}]Omega[{3,3}])/2/.elementaryOmega//Expand

ID2/.numOmega

ID2/.numOmega2

ID3=(Theta[{2}]Theta[{3,3}]-Omega[{3}]Omega[{2,2}]/.shuffle/.sol)/2-(Theta[{2}]Theta[{3,3}]-Omega[{3}]Omega[{2,2}])/2/.elementaryOmega//Expand

ID3/.numOmega

ID3/.numOmega2