Dynamical Systems and Theories of Class S

This is the supporting mathematica file for DDSlines.

GENERAL DEFINITIONS

Cluster Algebras

This is the set of commands used for arXiv:1307.7134, arXiv:1703.04786 and now arXiv:1912.xxxx

In this formula one has to enter the adjacency matrix of the quiver B and specify the integer k which corresponds to the node of the quiver which is mutated

Qmutation[B_,k_Integer]:=If[k==0 || k>Length[B[[1]]],B,Table[If[i==k||j==k,-B[[i,j]],B[[i,j]]+Sign[B[[i,k]]]Max[{0,B[[i,k]]B[[k,j]]}]],{i,Length[B[[1]]]},{j,Length[B[[1]]]}]]

mutQ[B_,v_]:=Fold[Qmutation,B,v]

X VARIABLES :
Definition of a mutation on the X-variables (or sometimes called u variables). Need as an input a SEED which is of the form seed={B,Xvariables} where B is the adjacency matrix of the quiver and Xvariables is a vector of x variables, for example X={x1,x2,x3} if the matrix B has rank 3

Xmutation[seed_,k_Integer]:=Module[{B=seed[[1]],X=seed[[2]],n=Length[seed[[1,1]]],pos,neg},
If[k==0 || k>Length[B[[1]]],{B,X},
pos=DeleteCases[Table[If[B[[i,k]]>0,i],{i,n}],Null];
neg=DeleteCases[Table[If[B[[i,k]]<0,i],{i,n}],Null];
{Qmutation[B,k],
Table[If[j==k,(1/(X[[k]]))(Product[((X[[i]])^(B[[i,k]])),{i,pos}]+Product[((X[[i]])^(-B[[i,k]])),{i,neg}]),X[[j]]],{j,n}]}]]

The definition above is for one mutation. The next allows a sequence of mutations. the second entry v_ is a vector which specifies the order of quiver nodes on which we mutate. if v={1,2,3} we mutate first at the vertex 1, then at 2 and finally at 3. Only the result after the sequence of mutations is displayed

Xmutations[seed_,v_]:=Fold[Xmutation,seed,v]

the output is the adjacency matrix B after the mutation sequence and a vector of X variables after the mutation sequence.

Now we define the right and left mutations

tauR[seed_,k_Integer]:=Module[{B=seed[[1]],Y=seed[[2]],n=Length[seed[[1,1]]],pos,neg},
If[k==0 || k>Length[B[[1]]],{B,Y},
pos=DeleteCases[Table[If[B[[i,k]]>0,i],{i,n}],Null];
neg=DeleteCases[Table[If[B[[i,k]]<0,i],{i,n}],Null];
{Qmutation[B,k],
Table[If[j==k,FullSimplify[-Y[[k]]],FullSimplify[Y[[j]] - Y[[k]] (Min[B[[k,j]],0])]],{j,n}]}]]

mutR[seed_,v_]:=Fold[tauR,seed,v]

tauL[seed_,k_Integer]:=Module[{B=seed[[1]],Y=seed[[2]],n=Length[seed[[1,1]]],pos,neg},
If[k==0 || k>Length[B[[1]]],{B,Y},
pos=DeleteCases[Table[If[B[[i,k]]>0,i],{i,n}],Null];
neg=DeleteCases[Table[If[B[[i,k]]<0,i],{i,n}],Null];
{Qmutation[B,k],
Table[If[j==k,FullSimplify[-Y[[k]]],FullSimplify[Y[[j]] + Y[[k]] (Max[B[[k,j]],0])]],{j,n}]}]]

mutL[seed_,v_]:=Fold[tauL,seed,v]

Compute the BPS spectrum when  the sequence of mutations is known

SpectrumR[seed_,list_]:=Module[{B=seed[[1]],Y=seed[[2]],n=Length[seed[[1,1]]],N=Length[list]},Do[Print[-mutR[{B,Y},Take[list,i]][[2,list[[i]]]]],{i,N}]]
SpectrumL[seed_,list_]:=Module[{B=seed[[1]],Y=seed[[2]],n=Length[seed[[1,1]]],N=Length[list]},Do[Print[-mutL[{B,Y},Take[list,i]][[2,list[[i]]]]],{i,N}]]

Example : A2 quiver

BA2={{0,1},{-1,0}}
A2basis={e1,e2}

mutL[{BA2,A2basis},{1}]
mutL[{BA2,A2basis},{1,2}]
mutL[{BA2,A2basis},{1,2,1}]

SpectrumL[{BA2,A2basis},{1,2,1}]

mutL[{BA2,A2basis},{2}]
mutL[{BA2,A2basis},{2,1}]
SpectrumL[{BA2,A2basis},{2,1}]

Rational transformations (in the notation of arXiv:1703.04786)

Rtransformation[seed_,k_Integer]:=Module[{B=seed[[1]],Y=seed[[2]],n=Length[seed[[1,1]]],pos,neg},
If[k==0 || k>Length[B[[1]]],{B,Y},
pos=DeleteCases[Table[If[B[[i,k]]>0,i],{i,n}],Null];
neg=DeleteCases[Table[If[B[[i,k]]<0,i],{i,n}],Null];
{Qmutation[B,k],
Simplify[Table[If[j==k,Cancel[1/Y[[k]]],Cancel[Y[[j]]  (1+Y[[k]]^(-Sign[B[[k,j]]]))^(-B[[k,j]])]],{j,n}]]}]]


Rop[seed_,v_]:=Fold[Rtransformation,seed,v]

RtransformationTilde[seed_,k_Integer]:=Module[{B=seed[[1]],Y=seed[[2]],n=Length[seed[[1,1]]],pos,neg},
If[k==0 || k>Length[B[[1]]],{B,Y},
pos=DeleteCases[Table[If[B[[i,k]]>0,i],{i,n}],Null];
neg=DeleteCases[Table[If[B[[i,k]]<0,i],{i,n}],Null];
{Qmutation[B,k],
Simplify[Table[If[j==k,Cancel[1/Y[[k]]],Cancel[Y[[j]]  (1+Y[[k]]^(Sign[B[[k,j]]]))^(B[[k,j]])]],{j,n}]]}]]


Rtop[seed_,v_]:=Fold[RtransformationTilde,seed,v]

Y-mutations left (the notation used in arXiv:1307.7134)

YmutationLeft[seed_,k_Integer]:=Module[{B=seed[[1]],Y=seed[[2]],n=Length[seed[[1,1]]],pos,neg},
If[k==0 || k>Length[B[[1]]],{B,Y},
pos=DeleteCases[Table[If[B[[i,k]]>0,i],{i,n}],Null];
neg=DeleteCases[Table[If[B[[i,k]]<0,i],{i,n}],Null];
{Qmutation[B,k],
Table[If[j==k,FullSimplify[1/Y[[k]]],FullSimplify[Y[[j]]  Y[[k]]^(Max[B[[k,j]],0]) (1+1/Y[[k]])^(B[[k,j]])]],{j,n}]}]]


YmutL[seed_,v_]:=Fold[YmutationLeft,seed,v]

This function serves for iterating mutation sequences: list is the mutation sequence and number the number of times it has to be iterated

MutSeq[list_,number_]:=If[number==0,{0},Join[Flatten[NestList[Append[#,list]&,{list},number][[number]]]]]

Now we find an algorithm to find green sequences (BY BRUTE FORCE)

This function gives the sign of the seed, replacing ei by 1, assuming the mutation sequence is correct

SignR[seed_,list_]:=Module[{B=seed[[1]],x=seed[[2]],n=Length[seed[[2]]]},mutR[{B,Table[1,{n}]},list][[2]]]
SignL[seed_,list_]:=Module[{B=seed[[1]],x=seed[[2]],n=Length[seed[[2]]]},mutL[{B,Table[1,{n}]},list][[2]]]

this function tells me if the node i is green and if it is gives a list with i added

GreenVectR[seed_,list_,i_]:=Module[{B=seed[[1]],x=seed[[2]],n=Length[seed[[2]]]},If[SignR[{B,x},list][[i]]>0,Append[list,i]]]
GreenVectL[seed_,list_,i_]:=Module[{B=seed[[1]],x=seed[[2]],n=Length[seed[[2]]]},If[SignL[{B,x},list][[i]]>0,Append[list,i]]]

given a list, this function gives the list of green vectors with one step more already in the form of a mutation list

GreenSR[seed_,list_]:=Module[{B=seed[[1]],x=seed[[2]],n=Length[seed[[2]]]},DeleteCases[Reap[Do[Sow[GreenVectR[{B,x},list,i]],{i,1,n}]][[2,1]],Null]]
GreenSL[seed_,list_]:=Module[{B=seed[[1]],x=seed[[2]],n=Length[seed[[2]]]},DeleteCases[Reap[Do[Sow[GreenVectL[{B,x},list,i]],{i,1,n}]][[2,1]],Null]]

(* same as GreenS but accepts input a list of lists *)

GreenSSR[seed_,list_]:=Module[{N=Length[list]},{seed,Flatten[DeleteCases[Reap[Do[Sow[GreenSR[seed,list[[i]]]],{i,1,N}]][[2,1]],Null],1]}]
GreenSSL[seed_,list_]:=Module[{N=Length[list]},{seed,Flatten[DeleteCases[Reap[Do[Sow[GreenSL[seed,list[[i]]]],{i,1,N}]][[2,1]],Null],1]}]

(* checks if a list (or more lists) is green or not; it prints it only if it is green *)

GreenCheckerR[seed_,list_]:=If[Length[GreenSR[seed,list]]==0,Print[list]]
GreenCheckerL[seed_,list_]:=If[Length[GreenSL[seed,list]]==0,Print[list]]

GreenCheckerSR[seed_,list_]:=Module[{N=Length[list]},DeleteCases[Reap[Do[Sow[If[Length[GreenSR[seed,list[[i]]]]==0,Print[list[[i]]]]],{i,1,N}]],Null]]
GreenCheckerSL[seed_,list_]:=Module[{N=Length[list]},DeleteCases[Reap[Do[Sow[If[Length[GreenSL[seed,list[[i]]]]==0,Print[list[[i]]]]],{i,1,N}]],Null]]

(* finds ALL the green sequences starting from firstnode: warning!! they can be infinite *)

GreenSequenceR[seed_,firstnode_]:=Module[{B=seed[[1]],x=seed[[2]]},DeleteCases[Flatten[GreenCheckerSR[{B,x},Flatten[Reap[NestWhile[GreenSSR @@#&,{{B,x},GreenSR[{B,x},{firstnode}]},(Sow[{##}[[1,2]]];Length[##[[2]]]>0)&]][[2]],2]]],Null]]
GreenSequenceL[seed_,firstnode_]:=Module[{B=seed[[1]],x=seed[[2]]},DeleteCases[Flatten[GreenCheckerSL[{B,x},Flatten[Reap[NestWhile[GreenSSL @@#&,{{B,x},GreenSL[{B,x},{firstnode}]},(Sow[{##}[[1,2]]];Length[##[[2]]]>0)&]][[2]],2]]],Null]]

(* find all the green sequences after bound steps, which therefore have at most bound elements *)

BoundedGreenSequenceR[seed_,firstnode_,bound_]:=Module[{B=seed[[1]],x=seed[[2]]},DeleteCases[Flatten[GreenCheckerSR[{B,x},Flatten[Reap[NestWhile[GreenSSR @@#&,{{B,x},GreenSR[{B,x},{firstnode}]},(Sow[{##}[[1,2]]];Length[##[[2]]]>0)&,1,bound-1]][[2]],2]]],Null]]
BoundedGreenSequenceL[seed_,firstnode_,bound_]:=Module[{B=seed[[1]],x=seed[[2]]},DeleteCases[Flatten[GreenCheckerSL[{B,x},Flatten[Reap[NestWhile[GreenSSL @@#&,{{B,x},GreenSL[{B,x},{firstnode}]},(Sow[{##}[[1,2]]];Length[##[[2]]]>0)&,1,bound-1]][[2]],2]]],Null]]

SECTION 4: MUTATION ORBITS

SU(3)/Z3

SU(3) data

BSU3={{0,0,-2,1},{0,0,1,-2},{2,-1,0,0},{-1,2,0,0}}
SU3basis={e1,e2,e3,e4}
YseedSU3={y1,y2,y3,y4}

mutL[{BSU3,SU3basis},{1,2,3,4,1,2}]

Note the permutation of the seed, and that the adjacency matrix is the opposite, the two Cartans have been exchanged

SpectrumL[{BSU3,SU3basis},{1,2,3,4,1,2}]

The associated rational transformation is

Rop[{BSU3,{y1,y2,y3,y4}},{1,2,3,4,1,2}][[2]]

The line operators considered in the main text are

LSU30cycA[{y1_,y2_,y3_,y4_}]:=y1^(1/3) y2^(2/3)
LSU30cycB[{y1_,y2_,y3_,y4_}]:=y1^(2/3) y2^(1/3)
LSU31cycC[{y1_,y2_,y3_,y4_}]:=y3^(-1/3) y4^(-2/3)
LSU31cycD[{y1_,y2_,y3_,y4_}]:=y3^(-2/3) y4^(-1/3)
LSU32cycE[{y1_,y2_,y3_,y4_}]:=y1^(1/3) y2^(2/3)y3^(-1/3) y4^(-2/3)
LSU32cycF[{y1_,y2_,y3_,y4_}]:=y1^(2/3) y2^(1/3)y3^(-2/3) y4^(-1/3)

To generate the orbits of line operators we need to introduce the inverse transformation. This is given by the inverse sequence of mutations, but we have to be careful with the permutations. The inverse sequence of mutations is 2,1,4,3,2,1. However after the sequence of mutations which generate the spectrum 
1) the seed has been permuted 1 <->4 and 2 <->3 . Since we are inverting the transformation, this permutation now acts first. Therefore the actual sequence of mutations we have to use is 3,4,1,2,3,4
2) there is also an algebraic permutation, the adjacency matrix of the quiver is the opposite (the two Cartan have been exchanged). Therefore after the transformation, if we want it to act on the original quiver, we must permute (1,2) <--> (3,4). We also skip the last permutation, and permute direclty the entries of the line operators we generate, but this is more convenient

RopPermSU3[{y1_,y2_,y3_,y4_}]:=Permute[Rop[{BSU3,{y1,y2,y3,y4}},{3,4,1,2,3,4}][[2]],{3,4,1,2}]

RopPermSU3[{y1,y2,y3,y4}]

It is more convenient to work with the fractional monodromy. By the same argument as before we introduce

RopFracPermSU3[{y1_,y2_,y3_,y4_}]:=Permute[Rop[{BSU3,{y1,y2,y3,y4}},{3,4}][[2]],{3,4,1,2}]

RopFracPermSU3[{y1,y2,y3,y4}]

We can also introduce the transformation which generates the other half of the families

RopFracPermSU3Inv[{y1_,y2_,y3_,y4_}]:=Permute[Rop[{BSU3,{y1,y2,y3,y4}},{2,1}][[2]],{3,4,1,2}]

RopFracPermSU3Inv[{y1,y2,y3,y4}]

(* ------------------   ( SU3/Z3 )_0 ---------------------- *)

I apply the half monodromy (in nest the step of the iteration is 3, so the transformation corresponds to the half monodromy)

Do[Print[Cancel[PowerExpand
[LSU30cycA[Nest[RopFracPermSU3,YseedSU3,n]]]
]],{n,0,9,3}]

Do[Print[Cancel[PowerExpand
[LSU30cycA[Nest[RopFracPermSU3Inv,YseedSU3,n]]]
]],{n,0,9,3}]

Do[Print[Cancel[PowerExpand
[LSU30cycB[Nest[RopFracPermSU3,YseedSU3,n]]]
]],{n,0,9,3}]

Do[Print[Cancel[PowerExpand
[LSU30cycB[Nest[RopFracPermSU3Inv,YseedSU3,n]]]
]],{n,0,9,3}]

(* ---------------------------------------------------------------------- *)
(* -------------------------   ( SU3/Z3 )_1 ----------------------------- *)(* ---------------------------------------------------------------------- *)

Do[Print[Cancel[PowerExpand
[LSU31cycC[Nest[RopFracPermSU3,YseedSU3,n]]]
]],{n,0,9,3}]

Do[Print[Cancel[PowerExpand
[LSU31cycC[Nest[RopFracPermSU3Inv,YseedSU3,n]]]
]],{n,0,9,3}]

Do[Print[Cancel[PowerExpand
[LSU31cycD[Nest[RopFracPermSU3,YseedSU3,n]]]
]],{n,0,9,3}]

Do[Print[Cancel[PowerExpand
[LSU31cycD[Nest[RopFracPermSU3Inv,YseedSU3,n]]]
]],{n,0,9,3}]

(* ---------------------------------------------------------------------- *)
(* --------------------------   ( SU3/Z3 )_2 ---------------------------- *)(* ---------------------------------------------------------------------- *)

Do[Print[Cancel[PowerExpand
[LSU32cycE[Nest[RopFracPermSU3,YseedSU3,n]]]
]],{n,0,9,3}]

Do[Print[Cancel[PowerExpand
[LSU32cycE[Nest[RopFracPermSU3Inv,YseedSU3,n]]]
]],{n,0,9,3}]

Do[Print[Cancel[PowerExpand
[LSU32cycF[Nest[RopFracPermSU3,YseedSU3,n]]]
]],{n,0,9,3}]

Do[Print[Cancel[PowerExpand
[LSU32cycF[Nest[RopFracPermSU3Inv,YseedSU3,n]]]
]],{n,0,9,3}]

(* -----------------------  *)
(* -----------------------  *)

Now we write all the charges in compact form

OpA1[n_]:=-2/3 (3 n+1)e1-(3 n+1)/3e2-2 n e3-n e4

OpA2[n_]:=-1/3 (3 n-1)e1-2/3(3 n-1)e2- n e3-2n e4

OpA1[0]
OpA1[1]
OpA1[2]
OpA1[3]

OpA2[0]
OpA2[1]
OpA2[2]
OpA2[3]

OpB1[n_]:=-1/3 (3 n+1)e1-2/3(3 n+1)e2- n e3-2n e4

OpB2[n_]:=-2/3 (3 n-1)e1-1/3(3 n-1)e2-2 n e3-n e4

OpB1[0]
OpB1[1]
OpB1[2]
OpB1[3]

OpB2[0]
OpB2[1]
OpB2[2]
OpB2[3]

OpC1[n_]:=-2n e1-n e2-2/3 (3 n-1)e3-1/3(3 n-1)e4

OpC2[n_]:=-n e1-2n e2-1/3 (3 n+1)e3-2/3(3 n+1)e4

OpC1[0]
OpC1[1]
OpC1[2]
OpC1[3]

OpC2[0]
OpC2[1]
OpC2[2]
OpC2[3]

OpD1[n_]:=-n e1-2 n e2-1/3 (3n-1)e3-1/3(6 n-2)e4

OpD2[n_]:=-2 n e1- n e2-2/3 (3n+1)e3-1/3(3 n+1)e4

OpD1[0]
OpD1[1]
OpD1[2]
OpD1[3]

OpD2[0]
OpD2[1]
OpD2[2]
OpD2[3]

OpE1[n_]:=-2/3 (6n+1)e1-1/3 (6n+1)e2-2/3 (6n-1)e3-1/3 (6n-1)e4

OpE2[n_]:=-1/3 (6n-1)e1-2/3 (6n-1)e2-1/3 (6n+1)e3-2/3 (6n+1)e4

OpE1[0]
OpE1[1]
OpE1[2]
OpE1[3]

OpE2[0]
OpE2[1]
OpE2[2]
OpE2[3]

OpF1[n_]:=-1/3 (6n+1)e1-2/3 (6n+1)e2-1/3 (6n-1)e3-2/3 (6n-1)e4

OpF2[n_]:=-2/3 (6n-1)e1-1/3 (6n-1)e2-2/3 (6n+1)e3-1/3 (6n+1)e4

OpF1[0]
OpF1[1]
OpF1[2]
OpF1[3]

OpF2[0]
OpF2[1]
OpF2[2]
OpF2[3]

(* -----------------------  *)
(* -----------------------  *)
(* -------  *)
(* -----------------------  *)
(* example used in the text: only chosen because vevs are and easier to type in the paper shorter *)

Now we see that the smalles monodromy maps theories into theories. By applying it one a convenient line operator I can generate line operators of all the three theories, corresponding to unphysical theta angle rotations

Lbup[{y1_,y2_,y3_,y4_}]:=(y3^(2/3)) (y4^(1/3)) (1+y1+y1 y4+2 y1 y2 y4+y1 (y2^2) y4)

Do[Print[Cancel[PowerExpand
[Lbup[Nest[RopFracPermSU3,YseedSU3,n]]]
]],{n,0,4}]

SECTION 5: SPECTRUM GENERATOR

SU(2) - first solution

Clear[W2]

Clear[a00,a01,a10,b00,b01,b10,c00,c01,c10,d00,d10,d01]

Derivation of the 1/4 monodromy from the invariance of the fundamental Wilson line

The fundamental Wilson line is

W2[{x_,y_}]:=PowerExpand[1/Sqrt[x y]+Sqrt[y/x]+Sqrt[x y]]

for the monodromy I take the ansatz, given by the ratio of two polynomials

Pol1[x_]:=x (a00+a10 x+a01 y)^2/(b00+b10 x+b01 y)^2
Pol2[y_]:=y  (c00+c10 x+c01 y)^2/(d00+d10 x+d01 y)^2

I put this ansatz in the condition that W2 is invariant, and separate numerator and denominator

NumW2=Numerator[Cancel[Factor[W2[{Pol2[y],Pol1[x]}]-W2[{x,y}]]]]

DenW2=Denominator[Cancel[Factor[W2[{Pol2[y],Pol1[x]}]-W2[{x,y}]]]]

I have to be careful that the denominator does not vanish

now I derive a series of conditions imposing that the coefficients of NumW2 of all the monomials in x and y all vanish independently

CondW2=Flatten[CoefficientList[NumW2,{x,y}]]

more explicitly the conditions are

Do[Print[{i,CondW2[[i]]}],{i,1,Length[CondW2]}]

by looking at these conditions I see that I can set certain variables to zero, being careful that the denominator does not vanish. This is a guess, will need to check that the remaning equations have solutions

b00=0;
b01=0;
a10=0;
c01=0;
d10=0;
d01=0;

now I take a sample of the remaining conditions and solve them by brute force (these are the equations written in the main text)

CondW2[[7]]
CondW2[[10]]
CondW2[[13]]
CondW2[[20]]
CondW2[[21]]

Solve[CondW2[[7]]==0&&CondW2[[10]]==0&&CondW2[[13]]==0&&CondW2[[20]]==0&&CondW2[[21]]==0&&0<a00≤2&&0≤b10≤2&&0<c00≤2&&0<d00≤2&&0≤a01≤2&&0≤c10≤2,{a00,b10,c00,d00,a01,c10},Integers]

Pol1[x]/.{a00->1,b10->1,c00->1,d00->1,a01->0,c10->1}
Pol2[y]/.{a00->1,b10->1,c00->1,d00->1,a01->0,c10->1}

Pol1[x]/.{a00->1,b10->1,c00->2,d00->2,a01->0,c10->2}
Pol2[y]/.{a00->1,b10->1,c00->2,d00->2,a01->0,c10->2}

Pol1[x]/.{a00->2,b10->2,c00->1,d00->1,a01->0,c10->1}
Pol2[y]/.{a00->2,b10->2,c00->1,d00->1,a01->0,c10->1}

Pol1[x]/.{a00->2,b10->2,c00->2,d00->2,a01->0,c10->2}
Pol2[y]/.{a00->2,b10->2,c00->2,d00->2,a01->0,c10->2}

They all give the same rational transformation. Pick the first

a00=1;
b10=1;
c00=1;
d00=1;
a01=0;
c10=1;

check the equations

NumW2=Numerator[Cancel[Factor[W2[{Pol2[y],Pol1[x]}]-W2[{x,y}]]]]

so the monodromy is

Pol1[x]
Pol2[y]

which agree with the expected result. Indeed let us derive the 1/4 and 1/2 monodromies

BSU2={{0,-2},{2,0}}

Yseed={x,y}

mutL[{BSU2,{e1,e2}},{1,2}]

mutL[{BSU2,{e1,e2}},{1}][[1]]

The transformation we have found is

Permute[Rop[{BSU2,{x,y}},{1}][[2]],{2,1}]

which indeed leaves the Wilson line invariant

Simplify[W2[Permute[Rop[{BSU2,{x,y}},{1}][[2]],{2,1}]]-W2[{x,y}]]

Furthermore by iteration

Permute[Rop[{BSU2,Permute[Rop[{BSU2,{x,y}},{1}][[2]],{2,1}]},{1}][[2]],{2,1}]

we reproduce the 1/2 monodromy

Rop[{BSU2,{x,y}},{1,2}][[2]]

which of course also leaves W2 invariant

Simplify[W2[Rop[{BSU2,{x,y}},{1,2}][[2]]]-W2[{x,y}]]

SU(2) - second solution

Clear[W2]

Clear[a00,a01,a10,b00,b01,b10,c00,c01,c10,d00,d10,d01]

Derivation of the 1/4 monodromy from the invariance of the fundamental Wilson line

The fundamental Wilson line is

W2[{x_,y_}]:=PowerExpand[1/Sqrt[x y]+Sqrt[y/x]+Sqrt[x y]]

for the monodromy I take the ansatz made from two polynomials

Pol1[x_]:=x (a00+a10 x+a01 y)^2/(b00+b10 x+b01 y)^2
Pol2[y_]:=y  (c00+c10 x+c01 y)^2/(d00+d10 x+d01 y)^2

I put this ansatz in the condition that W2 is invariant, and separate numerator and denominator

NumW2=Numerator[Cancel[Factor[W2[{Pol2[y],Pol1[x]}]-W2[{x,y}]]]]

DenW2=Denominator[Cancel[Factor[W2[{Pol2[y],Pol1[x]}]-W2[{x,y}]]]]

I have to be careful that the denominator does not vanish

now I derive a series of conditions imposing that the coefficients of NumW2 of all the monomials in x and y all vanish independently

CondW2=Flatten[CoefficientList[NumW2,{x,y}]]

more explicitly the conditions are

Do[Print[{i,CondW2[[i]]}],{i,1,Length[CondW2]}]

by looking at these conditions I see that I can set certain variables to zero, being careful that the denominator does not vanish. This is a guess, will need to check that the remaning equations have solutions

c01=0

c10=0

a10=0

b10=0

a00=0

d00=0

d10=0

now I take a sample of the remaining conditions and solve them by brute force (these are the equations written in the main text)

CondW2[[3]]
CondW2[[4]]
CondW2[[5]]
CondW2[[10]]
CondW2[[11]]

Solve[CondW2[[3]]==0&&CondW2[[4]]==0&&CondW2[[5]]==0&&CondW2[[10]]==0&&CondW2[[11]]==0&&0<a01≤2&&0≤b00≤2&&0<c00≤2&&0<d01≤2&&0≤b01≤2,{a01,b00,c00,d01,b01},Integers]

Pol1[x]/.{a01->1,b00->1,c00->1,d01->1,b01->1}
Pol2[y]/.{a01->1,b00->1,c00->1,d01->1,b01->1}

Pol1[x]/.{a01->1,b00->1,c00->2,d01->2,b01->1}
Pol2[y]/.{a01->1,b00->1,c00->2,d01->2,b01->1}

Pol1[x]/.{a01->2,b00->2,c00->1,d01->1,b01->2}
Pol2[y]/.{a01->2,b00->2,c00->1,d01->1,b01->2}

Pol1[x]/.{a01->2,b00->2,c00->2,d01->2,b01->2}
Pol2[y]/.{a01->2,b00->2,c00->2,d01->2,b01->2}

They all give the same rational transformation. Pick the first

a01=1;
b00=1;
c00=1;
d01=1;
b01=1;

check the equations

NumW2=Numerator[Cancel[Factor[W2[{Pol2[y],Pol1[x]}]-W2[{x,y}]]]]

so the monodromy is

Pol1[x]
Pol2[y]

which agree with the expected result. Indeed let us derive the 1/4 and 1/2 monodromies

BSU2={{0,-2},{2,0}}

Yseed={x,y}

mutL[{BSU2,{e1,e2}},{1,2}]

mutL[{BSU2,{e1,e2}},{1}][[1]]

The transformation we have found is now Rtop

Rtop[{BSU2,{y,x}},{1}][[2]]

acting on the permuted seed. This indeed leaves W2 invariant

Simplify[W2[Rtop[{BSU2,{y,x}},{1}][[2]]]-W2[{x,y}]]

Again we can compute its iteration

Rtop[{BSU2,Permute[Rtop[{BSU2,{y,x}},{1}][[2]],{2,1}]},{1}][[2]]

and check that also this transformation leaves the Wilson line invariant

Simplify[W2[Rtop[{BSU2,Permute[Rtop[{BSU2,{y,x}},{1}][[2]],{2,1}]},{1}][[2]]]]

SU(2) N=2*

Clear[W2]

We begin with the definitions of the polynomials in the numerator and denominator

PolNum[x_,y_,z_]:=a000+z a001+(z^2) a002+y a010+y z a011+y (z^2) a012+(y^2) a020+(y^2) z a021+(y^2) (z^2) a022+x a100+x z a101+x (z^2) a102+x y a110+x y z a111+x y (z^2) a112+x (y^2) a120+x (y^2) z a121+x (y^2) (z^2) a122+(x^2) a200+(x^2) z a201+(x^2) (z^2) a202+(x^2) y a210+(x^2) y z a211+(x^2) y (z^2) a212+(x^2) (y^2) a220+(x^2) (y^2) z a221+(x^2) (y^2) (z^2) a222
PolDen[x_,y_,z_]:=b000+z b001+(z^2) b002+y b010+y z b011+y (z^2) b012+(y^2) b020+(y^2) z b021+(y^2) (z^2) b022+x b100+x z b101+x (z^2) b102+x y b110+x y z b111+x y (z^2) b112+x (y^2) b120+x (y^2) z b121+x (y^2) (z^2) b122+(x^2) b200+(x^2) z b201+(x^2) (z^2) b202+(x^2) y b210+(x^2) y z b211+(x^2) y (z^2) b212+(x^2) (y^2) b220+(x^2) (y^2) z b221+(x^2) (y^2) (z^2) b222

We put all the variables in a list

ListVariables={a000,a001,a002,a010,a011,a012,a020,a021,a022,a100,a101,a102,a110,a111,a112,a120,a121,a122,a200,a201,a202,a210,a211,a212,a220,a221,a222,b000,b001,b002,b010,b011,b012,b020,b021,b022,b100,b101,b102,b110,b111,b112,b120,b121,b122,b200,b201,b202,b210,b211,b212,b220,b221,b222};

We take a line operator

W2[{x_,y_}]:=PowerExpand[1/Sqrt[x y]+Sqrt[x/y]+Sqrt[x y]]

Then the conditions look like

Factor[W2[{x,y}]-W2[{y Yn^2/Yd^2,x Xn^2/Xd^2}]]
Factor[W2[{z,x}]-W2[{x Xn^2/Xd^2,z Zn^2/Zd^2}]]
Factor[W2[{y,z}]-W2[{z Zn^2/Zd^2,y Yn^2/Yd^2}]]

Num1W2=Numerator[Factor[W2[{x,y}]-W2[{y Yn^2/Yd^2,x Xn^2/Xd^2}]]]//.{Xn->PolNum[x,y,z],Xd->PolDen[x,y,z],Yn->PolNum[y,z,x],Yd->PolDen[y,z,x],Zn->PolNum[z,x,y],Zd->PolDen[z,x,y]};

Num2W2=Numerator[Factor[W2[{z,x}]-W2[{x Xn^2/Xd^2,z Zn^2/Zd^2}]]]//.{Xn->PolNum[x,y,z],Xd->PolDen[x,y,z],Yn->PolNum[y,z,x],Yd->PolDen[y,z,x],Zn->PolNum[z,x,y],Zd->PolDen[z,x,y]};

Num3W2=Numerator[Factor[W2[{y,z}]-W2[{z Zn^2/Zd^2,y Yn^2/Yd^2}]]]//.{Xn->PolNum[x,y,z],Xd->PolDen[x,y,z],Yn->PolNum[y,z,x],Yd->PolDen[y,z,x],Zn->PolNum[z,x,y],Zd->PolDen[z,x,y]};

Explicitly

Cond1W2=Flatten[CoefficientList[Num1W2,{x,y,z}]]

Cond2W2=Flatten[CoefficientList[Num2W2,{x,y,z}]]

Cond3W2=Flatten[CoefficientList[Num3W2,{x,y,z}]]

We take a partial list of equations

ListOfEquations=DeleteCases[DeleteDuplicates[Flatten[{Reap[Do[If[Length[Cond1W2[[i]]]<40,Sow[Cond1W2[[i]]]],{i,1,Length[Cond1W2]}]],
Reap[Do[If[Length[Cond2W2[[i]]]<40,Sow[Cond2W2[[i]]]],{i,1,Length[Cond2W2]}]],Reap[Do[If[Length[Cond3W2[[i]]]<40,Sow[Cond3W2[[i]]]],{i,1,Length[Cond3W2]}]]}]],Null]

We solve them by hand. We look at the smallest equations and solve them by looking at them. Then we repeat the procedure (for simplicity we remove equations satisfied, whose length is therefore zero)

Do[If[Length[ListOfEquations[[i]]]<3&&Length[ListOfEquations[[i]]]≠0,Print[{i,ListOfEquations[[i]]}]],{i,1,Length[ListOfEquations]}]

a000=1;
b000=1;
a222=1;
b222=1;

Do[If[Length[ListOfEquations[[i]]]<3&&Length[ListOfEquations[[i]]]≠0,Print[{i,ListOfEquations[[i]]}]],{i,1,Length[ListOfEquations]}]

a220=0;
b022=0;

Do[If[Length[ListOfEquations[[i]]]<3&&Length[ListOfEquations[[i]]]≠0,Print[{i,ListOfEquations[[i]]}]],{i,1,Length[ListOfEquations]}]

a200=0;
b020=0;

Do[If[Length[ListOfEquations[[i]]]<3&&Length[ListOfEquations[[i]]]≠0,Print[{i,ListOfEquations[[i]]}]],{i,1,Length[ListOfEquations]}]

a210=0;
b021=0;

Do[If[Length[ListOfEquations[[i]]]<3&&Length[ListOfEquations[[i]]]≠0,Print[{i,ListOfEquations[[i]]}]],{i,1,Length[ListOfEquations]}]

b002=0;
a020=0;

Do[If[Length[ListOfEquations[[i]]]<3&&Length[ListOfEquations[[i]]]≠0,Print[{i,ListOfEquations[[i]]}]],{i,1,Length[ListOfEquations]}]

b200=0;
a002=0;

Do[If[Length[ListOfEquations[[i]]]<3&&Length[ListOfEquations[[i]]]≠0,Print[{i,ListOfEquations[[i]]}]],{i,1,Length[ListOfEquations]}]

a022=0;
a221=0;

Do[If[Length[ListOfEquations[[i]]]<3&&Length[ListOfEquations[[i]]]≠0,Print[{i,ListOfEquations[[i]]}]],{i,1,Length[ListOfEquations]}]

b012=0;
b220=0;

Do[If[Length[ListOfEquations[[i]]]<3&&Length[ListOfEquations[[i]]]≠0,Print[{i,ListOfEquations[[i]]}]],{i,1,Length[ListOfEquations]}]

a202=0;
b202=0;

Do[If[Length[ListOfEquations[[i]]]<3&&Length[ListOfEquations[[i]]]≠0,Print[{i,ListOfEquations[[i]]}]],{i,1,Length[ListOfEquations]}]

b122=0;
a122=0;

Do[If[Length[ListOfEquations[[i]]]<3&&Length[ListOfEquations[[i]]]≠0,Print[{i,ListOfEquations[[i]]}]],{i,1,Length[ListOfEquations]}]

b221=1;
a212=1;
b212=0;
b010=0;

Do[If[Length[ListOfEquations[[i]]]<3&&Length[ListOfEquations[[i]]]≠0,Print[{i,ListOfEquations[[i]]}]],{i,1,Length[ListOfEquations]}]

a100=0;

Do[If[Length[ListOfEquations[[i]]]<3&&Length[ListOfEquations[[i]]]≠0,Print[{i,ListOfEquations[[i]]}]],{i,1,Length[ListOfEquations]}]

b100=0;

Do[If[Length[ListOfEquations[[i]]]<3&&Length[ListOfEquations[[i]]]≠0,Print[{i,ListOfEquations[[i]]}]],{i,1,Length[ListOfEquations]}]

a010=1;

Do[If[Length[ListOfEquations[[i]]]<3&&Length[ListOfEquations[[i]]]≠0,Print[{i,ListOfEquations[[i]]}]],{i,1,Length[ListOfEquations]}]

a001=0;
b001=1;
a201=0;

Now that the system is more maneageable we solve it by inspection, by looking at the forms of Cond1W2, Cond2W2 and Cond3W3

a102=0;
b210=0;
a021=0;
b102=0;

a101=b011;
a012=b201;
a211=b112;

a011=b101;

a201=0;
b011=0;

a110=b110;

b101=2;

a112=b211;

b110=0;
b112=0;

a120=b120;
a111=b111;
a120=b120;

b201=1;
b120=0;

b111=0;
a121=0;
b121=0;

b211=2;

We check that all the equations have been solved, by checking that all the Conditions above are now identically zero

AllTrue[Cond1W2,PossibleZeroQ]

AllTrue[Cond2W2,PossibleZeroQ]

AllTrue[Cond3W2,PossibleZeroQ]

PolNum[x,y,z]

PolDen[x,y,z]

By inspection the solution is given in terms of the following polynomial

Pol[x1_,x2_,x3_]:=1+x1+2 x1 x2+x1 x2^2+ 2 x1 x2^2 x3+x1 x2^2 x3^2+x1^2 x2^2 x3^2

We now check the invariance for the three line operators, which only differs by cyclic permutations

Simplify[Cancel[W2[{y Pol[z,x,y]^2/Pol[x,y,z]^2,x Pol[y,z,x]^2/Pol[z,x,y]^2}]]-W2[{x,y}]]

Simplify[Cancel[W2[{z Pol[x,y,z]^2/Pol[y,z,x]^2,y Pol[z,x,y]^2/Pol[x,y,z]^2}]]-W2[{y,z}]]

Simplify[Cancel[W2[{x Pol[y,z,x]^2/Pol[z,x,y]^2,z Pol[x,y,z]^2/Pol[y,z,x]^2}]]-W2[{z,x}]]

SECTION 6: SCFT & DAHA

SU(2) N=2*

Clear[W1,W2,W3]

The three operators

W1=X[-1/2(e1+e2)]+X[1/2 (e1-e2)]+X[1/2 (e1+e2)]
W2=X[-1/2(e2+e3)]+X[1/2 (e2-e3)]+X[1/2 (e2+e3)]
W3=X[-1/2(e3+e1)]+X[1/2 (e3-e1)]+X[1/2 (e3+e1)]

To check the DAHA relations we have to define a normal ordering to write the products of noncommutative X as a single X variable. The quiver data

Bstar={{0,2,-2},{-2,0,2},{2,-2,0}}

PairingStar[v1_,v2_]:=Block[{e1=UnitVector[3,1],e2=UnitVector[3,2],e3=UnitVector[3,3],B=Bstar},v1.B.v2]

The normal ordering data

GetX[exp_]:=Total[Variables[Block[{q=1},exp]]]
CoefX[exp_]:=exp/GetX[exp]

MonomialListLaurentQ[exp_]:=q^(Exponent[exp,q,Min])MonomialList[q^(-Exponent[exp,q,Min]) exp]

NOstar2[X[i_]]:=X[Expand[i]];
NOstar2D[expr_]:=CoefX[expr]NOstar2[GetX[expr]];

NOstar2[left___,X[i_],X[j_],right___]:=q^(- PairingStar[i,j])NOstar2[left,X[i+j],right]

NOstar2D[left___,expr1_,expr2_,right___]:=CoefX[expr1]CoefX[expr2] NOstar2D[left,NOstar2[GetX[expr1],GetX[expr2]],right]

NormalOrderStar2[expr1_,expr2_]:=Total[NOstar2D@@@Tuples[{MonomialListLaurentQ[expr1],MonomialListLaurentQ[expr2]}]]

The DAHA relations

Simplify[q^(1/2) NormalOrderStar2[W1,W2]-q^(-1/2)NormalOrderStar2[W2,W1]-(q-1/q) W3]

Simplify[q^(1/2) NormalOrderStar2[W2,W3]-q^(-1/2)NormalOrderStar2[W3,W2]-(q-1/q) W1]

Simplify[q^(1/2) NormalOrderStar2[W3,W1]-q^(-1/2)NormalOrderStar2[W1,W3]-(q-1/q) W2]

Expand[ (q NormalOrderStar2[W1,W1]+1/q NormalOrderStar2[W2,W2]+q NormalOrderStar2[W3,W3]-  q^(1/2) NormalOrderStar2[NormalOrderStar2[W1,W2],W3]) -(q^(1/2)+q^(-1/2))^2-(NormalOrderStar2[NOstar2D[I X[1/2 e1],X[1/2 e2],X[1/2 e3]] q^(1/2),NOstar2D[I X[1/2 e1],X[1/2 e2],X[1/2 e3]] q^(1/2)]+NormalOrderStar2[NOstar2D[-I X[-1/2 e3],X[-1/2 e2],X[-1/2 e1]] q^(-1/2),NOstar2D[-I X[-1/2 e3],X[-1/2 e2],X[-1/2 e1]] q^(-1/2)]-NormalOrderStar2[NOstar2D[I X[1/2 e1],X[1/2 e2],X[1/2 e3]] q^(1/2),NOstar2D[-I X[-1/2 e3],X[-1/2 e2],X[-1/2 e1]] q^(-1/2)]-NormalOrderStar2[NOstar2D[-I X[-1/2 e3],X[-1/2 e2],X[-1/2 e1]] q^(-1/2),NOstar2D[I X[1/2 e1],X[1/2 e2],X[1/2 e3]] q^(1/2)])]//.X[0]->1

N=2 Nf=4 SCFT

Quiver and line operators

BN4={{0,0,1,-1,1,-1},{0,0,-1,1,-1,1},{-1,1,0,0,0,0},{1,-1,0,0,0,0},{-1,1,0,0,0,0},{1,-1,0,0,0,0}}
N4basis={e1,e2,e3,e4,e5,e6}
YseedN4={y1,y2,y3,y4,y5,y6}

MatrixForm[BN4]

AdjacencyGraph[{e1,e2,e3,e4,e5,e6},{{0,0,1,0,1,0},{0,0,0,1,0,1},{0,1,0,0,0,0},{1,0,0,0,0,0},{0,1,0,0,0,0},{1,0,0,0,0,0}},VertexLabels->"Name"]

SpectrumL[{BN4,N4basis},{3,4,5,6,1,2,3,4,5,6,1,2}]

mutL[{BN4,N4basis},{3,4,5,6,1,2,3,4,5,6,1,2}]

Now we see that the framed quivers are invariant under the half  monodromy, or invariant under the 1/4 monodromy up to a permutation

Compute the pairing of W1 to the quiver

Pairings[core_]:=Table[core.BN4.UnitVector[6,i],{i,1,6}]

Pairings[{-1/2,-1/2,0,-1/2,0,-1/2}]

BN4W1={{0,0,1,-1,1,-1,1},{0,0,-1,1,-1,1,-1},{-1,1,0,0,0,0,0},{1,-1,0,0,0,0,0},{-1,1,0,0,0,0,0},{1,-1,0,0,0,0,0},{-1,1,0,0,0,0,0}}

Graphically

AdjacencyGraph[{e1,e2,e3,e4,e5,e6,gamma},{{0,0,1,0,1,0,1},{0,0,0,1,0,1,0},{0,1,0,0,0,0,0},{1,0,0,0,0,0,0},{0,1,0,0,0,0,0},{1,0,0,0,0,0,0},{0,1,0,0,0,0,0}},VertexLabels->"Name"]

mutL[{BN4W1,{e1,e2,e3,e4,e5,e6,core}},{3,4,5,6,1,2}][[1]]

AdjacencyGraph[{e1,e2,e3,e4,e5,e6,gamma},{{0,0,1,0,1,0,0},{0,0,0,1,0,1,1},{0,1,0,0,0,0,0},{1,0,0,0,0,0,0},{0,1,0,0,0,0,0},{1,0,0,0,0,0,0},{1,0,0,0,0,0,0}},VertexLabels->"Name"]

We see that it is invariant if we relabel 1 <->2 and (3,5)<->(4,6)

Compute the pairing of W2 to the quiver

Pairings[{-1/2,-1/2,-1/2,0,-1/2,0}]

BN4W2={{0,0,1,-1,1,-1,-1},{0,0,-1,1,-1,1,1},{-1,1,0,0,0,0,0},{1,-1,0,0,0,0,0},{-1,1,0,0,0,0,0},{1,-1,0,0,0,0,0},{1,-1,0,0,0,0,0}}

Graphically

AdjacencyGraph[{e1,e2,e3,e4,e5,e6,gamma},{{0,0,1,0,1,0,0},{0,0,0,1,0,1,1},{0,1,0,0,0,0,0},{1,0,0,0,0,0,0},{0,1,0,0,0,0,0},{1,0,0,0,0,0,0},{1,0,0,0,0,0,0}},VertexLabels->"Name"]

mutL[{BN4W2,{e1,e2,e3,e4,e5,e6,core}},{3,4,5,6,1,2}][[1]]

AdjacencyGraph[{e1,e2,e3,e4,e5,e6,gamma},{{0,0,1,0,1,0,1},{0,0,0,1,0,1,0},{0,1,0,0,0,0,0},{1,0,0,0,0,0,0},{0,1,0,0,0,0,0},{1,0,0,0,0,0,0},{0,1,0,0,0,0,0}},VertexLabels->"Name"]

We see that it is invariant if we relabel 1 <->2 and (3,5)<->(4,6)

Compute the pairing of W2 to the quiver

Pairings[{0,-1,-1/2,-1/2,-1/2,-1/2}]

BN4W3={{0,0,1,-1,1,-1,0},{0,0,-1,1,-1,1,0},{-1,1,0,0,0,0,-1},{1,-1,0,0,0,0,1},{-1,1,0,0,0,0,-1},{1,-1,0,0,0,0,1},{0,0,1,-1,1,-1,0}}

Graphically

AdjacencyGraph[{e1,e2,e3,e4,e5,e6,gamma},{{0,0,1,0,1,0,0},{0,0,0,1,0,1,0},{0,1,0,0,0,0,0},{1,0,0,0,0,0,1},{0,1,0,0,0,0,0},{1,0,0,0,0,0,1},{0,0,1,0,1,0,0}},VertexLabels->"Name"]

mutL[{BN4W3,{e1,e2,e3,e4,e5,e6,core}},{3,4,5,6,1,2}][[1]]

AdjacencyGraph[{e1,e2,e3,e4,e5,e6,gamma},{{0,0,1,0,1,0,0},{0,0,0,1,0,1,0},{0,1,0,0,0,0,1},{1,0,0,0,0,0,0},{0,1,0,0,0,0,1},{1,0,0,0,0,0,0},{0,0,0,1,0,1,0}},VertexLabels->"Name"]

Again we see that it is invariant if we relabel 1 <->2 and (3,5)<->(4,6)

Rational transformations

Rational transformation

Rop[{BN4,{y1,y2,y3,y4,y5,y6}},{3,4,5,6,1,2}][[2]]

W1comm[{y1_,y2_,y3_,y4_,y5_,y6_}]:=(1/((Sqrt[y1]) (Sqrt[y2]) (Sqrt[y4]) (Sqrt[y6])))+((Sqrt[y2])/((Sqrt[y1]) (Sqrt[y4]) (Sqrt[y6])))+(((Sqrt[y2]) (Sqrt[y4]))/((Sqrt[y1]) (Sqrt[y6])))+(((Sqrt[y2]) (Sqrt[y6]))/((Sqrt[y1]) (Sqrt[y4])))+(((Sqrt[y2]) (Sqrt[y4]) (Sqrt[y6]))/(Sqrt[y1]))+(Sqrt[y1]) (Sqrt[y2]) (Sqrt[y4]) (Sqrt[y6])

W2comm[{y1_,y2_,y3_,y4_,y5_,y6_}]:=(1/((Sqrt[y1]) (Sqrt[y2]) (Sqrt[y3]) (Sqrt[y5])))+((Sqrt[y1])/((Sqrt[y2]) (Sqrt[y3]) (Sqrt[y5])))+(((Sqrt[y1]) (Sqrt[y3]))/((Sqrt[y2]) (Sqrt[y5])))+(((Sqrt[y1]) (Sqrt[y5]))/((Sqrt[y2]) (Sqrt[y3])))+(((Sqrt[y1]) (Sqrt[y3]) (Sqrt[y5]))/(Sqrt[y2]))+(Sqrt[y1]) (Sqrt[y2]) (Sqrt[y3]) (Sqrt[y5])

W3comm[{y1_,y2_,y3_,y4_,y5_,y6_}]:=(1/(y2 (Sqrt[y3]) (Sqrt[y4]) (Sqrt[y5]) (Sqrt[y6])))+((Sqrt[y3])/((Sqrt[y4]) (Sqrt[y5]) (Sqrt[y6])))+((Sqrt[y3])/(y2 (Sqrt[y4]) (Sqrt[y5]) (Sqrt[y6])))+((Sqrt[y5])/((Sqrt[y3]) (Sqrt[y4]) (Sqrt[y6])))+((Sqrt[y5])/(y2 (Sqrt[y3]) (Sqrt[y4]) (Sqrt[y6])))+((2 (Sqrt[y3]) (Sqrt[y5]))/((Sqrt[y4]) (Sqrt[y6])))+(((Sqrt[y3]) (Sqrt[y5]))/(y2 (Sqrt[y4]) (Sqrt[y6])))+((y2 (Sqrt[y3]) (Sqrt[y5]))/((Sqrt[y4]) (Sqrt[y6])))+(((Sqrt[y3]) (Sqrt[y4]) (Sqrt[y5]))/(Sqrt[y6]))+((y2 (Sqrt[y3]) (Sqrt[y4]) (Sqrt[y5]))/(Sqrt[y6]))+(((Sqrt[y3]) (Sqrt[y5]) (Sqrt[y6]))/(Sqrt[y4]))+((y2 (Sqrt[y3]) (Sqrt[y5]) (Sqrt[y6]))/(Sqrt[y4]))+y2 (Sqrt[y3]) (Sqrt[y4]) (Sqrt[y5]) (Sqrt[y6])

Check of the invariance under the 1/4 monodromy. Note the permutation 1-2, 3-4, 5-6

Simplify[PowerExpand[Cancel[W1comm[Rop[{BN4,{y1,y2,y3,y4,y5,y6}},{3,4,5,6,1,2}][[2]]]]]-W1comm[{y2,y1,y4,y3,y6,y5}]]

Simplify[PowerExpand[Cancel[W2comm[Rop[{BN4,{y1,y2,y3,y4,y5,y6}},{3,4,5,6,1,2}][[2]]]]]-W2comm[{y2,y1,y4,y3,y6,y5}]]

Simplify[PowerExpand[Cancel[W3comm[Rop[{BN4,{y1,y2,y3,y4,y5,y6}},{3,4,5,6,1,2}][[2]]]]]-W3comm[{y2,y1,y4,y3,y6,y5}]]

For completeness we include also the invariance under the half monodromy (the permutation is 3-5, 4-6)

Simplify[PowerExpand[Cancel[W1comm[Rop[{BN4,{y1,y2,y3,y4,y5,y6}},{3,4,5,6,1,2,3,4,5,6,1,2}][[2]]]]]-W1comm[{y1,y2,y5,y6,y3,y4}]]

Simplify[PowerExpand[Cancel[W2comm[Rop[{BN4,{y1,y2,y3,y4,y5,y6}},{3,4,5,6,1,2,3,4,5,6,1,2}][[2]]]]]-W2comm[{y1,y2,y5,y6,y3,y4}]]

Simplify[PowerExpand[Cancel[W3comm[Rop[{BN4,{y1,y2,y3,y4,y5,y6}},{3,4,5,6,1,2,3,4,5,6,1,2}][[2]]]]]-W3comm[{y1,y2,y5,y6,y3,y4}]]

Also note

Simplify[PowerExpand[Cancel[W1comm[Rop[{BN4,{y1,y2,y5,y6,y3,y4}},{3,4,5,6,1,2}][[2]]]]]-W2comm[{y1,y2,y3,y4,y5,y6}]]

Checking the DAHA

In this section we check the spherical DAHA relations.

First we define a normal ordering for this quiver, since we are using noncommutative variables

Pairing[v1_,v2_]:=Block[{e1=UnitVector[6,1],e2=UnitVector[6,2],e3=UnitVector[6,3],e4=UnitVector[6,4],e5=UnitVector[6,5],e6=UnitVector[6,6],B=BN4},v1.B.v2]

For example

Pairing[e1+e3+4 e5+3 e4,e2+e6-e1]

GetX[exp_]:=Total[Variables[Block[{q=1},exp]]]
CoefX[exp_]:=exp/GetX[exp]

MonomialListLaurentQ[exp_]:=q^(Exponent[exp,q,Min])MonomialList[q^(-Exponent[exp,q,Min]) exp]

NO[X[i_]]:=X[Expand[i]];
NOD[expr_]:=CoefX[expr]NO[GetX[expr]];

NO[left___,X[i_],X[j_],right___]:=q^(- Pairing[i,j])NO[left,X[i+j],right]

NOD[left___,expr1_,expr2_,right___]:=CoefX[expr1]CoefX[expr2] NOD[left,NO[GetX[expr1],GetX[expr2]],right]

NormalOrder[expr1_,expr2_]:=Total[NOD@@@Tuples[{MonomialListLaurentQ[expr1],MonomialListLaurentQ[expr2]}]]

NormalOrder[2 q X[9 e1+2 e2],13q X[3 e3+1 e2]]

W1=X[-1/2(e1+e2+e4+e6)]+X[-1/2(e1-e2+e4+e6)]+X[-1/2(e1-e2-e4+e6)]+X[-1/2(e1-e2+e4-e6)]+X[-1/2(e1-e2-e4-e6)]+X[1/2(e1+e2+e4+e6)]

W2=X[-1/2(e1+e2+e3+e5)]+X[-1/2(-e1+e2+e3+e5)]+X[-1/2(-e1+e2-e3+e5)]+X[-1/2(-e1+e2+e3-e5)]+X[-1/2(-e1+e2-e3-e5)]+X[1/2(e1+e2+e3+e5)]

This operator is called W3 in the main text

W3bis=X[1/2 (-2 e2-e3-e4-e5-e6)]+X[1/2 (-e4+e3-e5-e6)]+X[1/2 (-2 e2-e4+e3-e5-e6)]+X[1/2 (-e3-e4-e6+e5)]+X[1/2 (-2 e2-e3-e4-e6+e5)]+(q+1/q) X[1/2 (-e4+e3-e6+e5)]+X[1/2 (-2 e2-e4+e3-e6+e5)]+X[1/2 (2 e2-e4+e3-e6+e5)]+X[1/2 (e3+e4-e6+e5)]+X[1/2 (2 e2+e3+e4-e6+e5)]+X[1/2 (-e4+e3+e5+e6)]+X[1/2 (2 e2-e4+e3+e5+e6)]+X[1/2 (2 e2+e3+e4+e5+e6)]

This operator is also possible, but it does not play a role in the main text. I include it for completeness (it takes the place of W3bis if I oppose the quiver)

W3other=X[1/2 (-2 e1-e3-e4-e5-e6)]+X[1/2 (-e3+e4-e5-e6)]+X[1/2 (-2 e1-e3+e4-e5-e6)]+X[1/2 (-e3-e4-e5+e6)]+X[1/2 (-2 e1-e3-e4-e5+e6)]+(q+1/q) X[1/2 (-e3+e4-e5+e6)]+X[1/2 (-2 e1-e3+e4-e5+e6)]+X[1/2 (2 e1-e3+e4-e5+e6)]+X[1/2 (e3+e4-e5+e6)]+X[1/2 (2 e1+e3+e4-e5+e6)]+X[1/2 (-e3+e4+e5+e6)]+X[1/2 (2 e1-e3+e4+e5+e6)]+X[1/2 (2 e1+e3+e4+e5+e6)]

P1=X[-1/2(e1+e2+e3+e6)]+X[1/2(e1+e2+e3+e6)]
P2=X[-1/2 (e5+e6)]+X[1/2 (e5+e6)]
P3=X[-1/2 (e3+e4)]+X[1/2 (e3+e4)]
P4=X[-1/2(e1+e2+e4+e5)]+X[1/2(e1+e2+e4+e5)]

Central23=-NormalOrder[P2,P3]-NormalOrder[P1,P4]
Central12=-NormalOrder[P1,P2]-NormalOrder[P3,P4]
Central13=-NormalOrder[P1,P3]-NormalOrder[P2,P4]

Actually ok, commutative limit works also with W3bis

Expand[Simplify[ (q NormalOrder[W1,W2]-q^(-1) NormalOrder[W2,W1])- (q^2-1/q^2) W3bis+(q-1/q) Central23]]

Expand[Simplify[ (q NormalOrder[W2,W3bis]-q^(-1) NormalOrder[W3bis,W2])- (q^2-1/q^2) W1+(q-1/q) Central13]]

Expand[Simplify[ (q NormalOrder[W3bis,W1]-q^(-1) NormalOrder[W1,W3bis])- (q^2-1/q^2) W2+(q-1/q) Central12]]

In the text a1=P1, a2=P3, a3=P2 a4=P4

P1=X[-1/2(e1+e2+e3+e6)]+X[1/2(e1+e2+e3+e6)]
P2=X[-1/2 (e5+e6)]+X[1/2 (e5+e6)]
P3=X[-1/2 (e3+e4)]+X[1/2 (e3+e4)]
P4=X[-1/2(e1+e2+e4+e5)]+X[1/2(e1+e2+e4+e5)]

In the text alpha3 = Central23, alpha1= Central13 and alpha2=Central12

Central23=-NormalOrder[P2,P3]-NormalOrder[P1,P4]
Central12=-NormalOrder[P1,P2]-NormalOrder[P3,P4]
Central13=-NormalOrder[P1,P3]-NormalOrder[P2,P4]

OmegaD=-NormalOrder[P1,P1]-NormalOrder[P2,P2]-NormalOrder[P3,P3]-NormalOrder[P4,P4]-NormalOrder[NormalOrder[NormalOrder[P1,P2],P3],P4]+(q+1/q)^2

NormalOrder[NormalOrder[NormalOrder[P1,P2],P3],P4]

OmegaDl=Simplify[Expand[- q NormalOrder[NormalOrder[W1,W2],W3bis]+q^(2) NormalOrder[W1,W1]+q^(-2) NormalOrder[W2,W2]+q^(2) NormalOrder[W3bis,W3bis]- q^(+1) NormalOrder[W1,Central13]-q^(-1) NormalOrder[W2,Central12]-q^(+1) NormalOrder[W3bis,Central23]]]

Check the last relation: it works!

Simplify[OmegaD-OmegaDl]//.X[0]->1

Aid in typing in the main text

Expand[Simplify[ (q NormalOrder[W1,W2]-q^(-1) NormalOrder[W2,W1])]]

Expand[Simplify[ - (q^2-1/q^2) W3bis+(q-1/q) Central23]]