QYBE solutions for constant R-Matrices over Grassmann Algebra With 2-generators & Finite Fields



Based upon the work of Steven Duplij, Olga Kotulska and Alexander Sadovnikov [1]

Mathematica 9.0 code by Dara O Shayda 
dara@lossofgenerality.com 

Grassmann Algebra Package by John Browne [2] 
grassmannalgebra@gmail.com


June 30, 2013

Clear[a,b,c,d,p,q];

Assume a, b, c, d, p and q belong to a multiplicative commutative distributive algebra, with both additive and multiplicative inverses.

Based upon the 6-vertex YBE solutions [3], the following matrix forms are created:

R=.;
R= ConstantArray[0,{4,4}];
R[[1]][[1]] = p;
R[[2]][[2]] = c;
R[[3]][[3]] = b;
R[[4]][[4]] = q;
R[[2]][[3]] = d;
R[[3]][[2]] = a;
R//MatrixForm

R12=.;
R12 = ConstantArray[0,{8,8}];
R12[[1]][[1]] = p;
R12[[2]][[2]] = p;
R12[[3]][[3]] = c;
R12[[4]][[4]] =c;
R12[[5]][[5]] =b;
R12[[6]][[6]] = b;
R12[[7]][[7]] = q;
R12[[8]][[8]] = q;
R12[[3]][[5]] = d;
R12[[4]][[6]] = d;
R12[[5]][[3]] = a;
R12[[6]][[4]] = a;
R12//MatrixForm

R13=.;
R13 = ConstantArray[0,{8,8}];
R13[[1]][[1]] = p;
R13[[2]][[2]] = c;
R13[[3]][[3]] = p;
R13[[4]][[4]] =c;
R13[[5]][[5]] =b;
R13[[6]][[6]] = q;
R13[[7]][[7]] = b;
R13[[8]][[8]] = q;
R13[[2]][[5]] = d;
R13[[4]][[7]] = d;
R13[[5]][[2]] = a;
R13[[7]][[4]] = a;
R13//MatrixForm

R23=.;
R23 = ConstantArray[0,{8,8}];
R23[[1]][[1]] = p;
R23[[2]][[2]] = c;
R23[[3]][[3]] = b;
R23[[4]][[4]] =q;
R23[[5]][[5]] =p;
R23[[6]][[6]] = c;
R23[[7]][[7]] = b;
R23[[8]][[8]] = q;
R23[[2]][[3]] = d;
R23[[6]][[7]] = d;
R23[[3]][[2]] = a;
R23[[7]][[6]] = a;
R23//MatrixForm

From the braid equation get the algebraic equations that must satisfy 0:

equations = Simplify[R12.R13.R23 - R23.R13.R12];
Style[equations//MatrixForm,FontSize->9]

From [1] check the computations:

Load the Grassmann Algebra package [2] :

<<"GrassmannAlgebra`"

Declare all the vectors and scalars and make an even algebra, two generators (Subscript[ζ, 1]),(Subscript[ζ, 2]) :

★A;DeclareVectorSymbols[(Subscript[ζ, 1]),(Subscript[ζ, 2])]
scalars=DeclareScalarSymbols[(Subscript[a, 0]),(Subscript[b, 0]),(Subscript[c, 0]),(Subscript[d, 0]),(Subscript[p, 0]),(Subscript[q, 0]),(Subscript[a, 12]),(Subscript[b, 12]),(Subscript[c, 12]),(Subscript[d, 12]),(Subscript[p, 12]),(Subscript[q, 12])]
X=★𝒢[(1+(Subscript[ζ, 1]))⋀(1+(Subscript[ζ, 2]))]

(* assign the 0s to only get the even terms *)
aa=.;
aa={(Subscript[a, 0]),0,0,(Subscript[a, 12])}.List@@X

bb=.;
bb={(Subscript[b, 0]),0,0,(Subscript[b, 12])}.List@@X

cc=.;
cc={(Subscript[c, 0]),0,0,(Subscript[c, 12])}.List@@X

dd=.;
dd={(Subscript[d, 0]),0,0,(Subscript[d, 12])}.List@@X

pp=.;
pp={(Subscript[p, 0]),0,0,(Subscript[p, 12])}.List@@X

qq=.;
qq={(Subscript[q, 0]),0,0,(Subscript[q, 12])}.List@@X

Replace the vars with the Grassmann generators and constants, EQ (28-31) in [1]:

expr1=GrassmannExpandAndSimplify[cc⋀dd⋀aa]

Collect the coefficients:

coeff1=CoefficientList[expr1, {(Subscript[ζ, 1])⋀(Subscript[ζ, 2])}]

expr2=GrassmannExpandAndSimplify[bb⋀dd⋀aa]

coeff2=CoefficientList[expr2, {(Subscript[ζ, 1])⋀(Subscript[ζ, 2])}]

expr3 =GrassmannExpandAndSimplify[dd⋀aa⋀(dd-aa)]

coeff3=CoefficientList[expr3,{(Subscript[ζ, 1])⋀(Subscript[ζ, 2])}]

expr4=GrassmannExpandAndSimplify[(pp⋀dd⋀(dd-pp)) + cc⋀bb⋀dd]

coeff4=CoefficientList[expr4,{(Subscript[ζ, 1])⋀(Subscript[ζ, 2])}]

expr5=GrassmannExpandAndSimplify[(qq⋀dd⋀(dd-qq)) + cc⋀bb⋀dd]

coeff5=CoefficientList[expr5,{(Subscript[ζ, 1])⋀(Subscript[ζ, 2])}]

expr6=GrassmannExpandAndSimplify[(pp⋀aa⋀(aa-pp)) + cc⋀bb⋀aa]

coeff6=CoefficientList[expr6,{(Subscript[ζ, 1])⋀(Subscript[ζ, 2])}]

expr7=GrassmannExpandAndSimplify[(qq⋀aa⋀(aa-qq)) + cc⋀bb⋀aa]

coeff7=CoefficientList[expr7,{(Subscript[ζ, 1])⋀(Subscript[ζ, 2])}]

Simplify and remove the duplicates and make a list of the equations, compare against the [1], 14 system of equations:

(* Exactly 14 equations *)
coeffSystem = DeleteDuplicates[Simplify[Join[coeff1, coeff2, coeff3,coeff4,coeff5,coeff6,coeff7]]]
Length[coeffSystem]

Case I:  Compare with [1]:

(* exactly 9 equations *)
caseI=DeleteCases[DeleteDuplicates[coeffSystem/.{(Subscript[d, 0])->0}], _Integer]
Length[caseI]

Solve this system of equations:

solCaseI=Solve[caseI==0, scalars]

Let’s compute the original R matrices, but plug in the Grassmann numbers:

R12Grassmann=R12/.{a->aa, b->bb, c->cc, d->dd, p->pp, q->qq};
Style[R12Grassmann//MatrixForm,FontSize->9]

In [1] they only reported one of the solutions:

R12Grassmann3=Flatten[R12Grassmann/.{solCaseI[[3]]},1];
R12Grassmann3/.{(Subscript[a, 0])->0,(Subscript[d, 0])->0,(Subscript[b, 0])->(t^2)/r,(Subscript[p, 0])->t, (Subscript[q, 0])->t, (Subscript[c, 0])->r, (Subscript[c, 12])->v, (Subscript[b, 12])->w, (Subscript[d, 12])->y, (Subscript[p, 12])->l, (Subscript[q, 12])->m, (Subscript[a, 12])->n,(Subscript[ζ, 1])⋀(Subscript[ζ, 2])->(Subscript[ζ, 1])(Subscript[ζ, 2])}//MatrixForm

Remark: We shorthand (Subscript[ζ, 1])⋀ (Subscript[ζ, 2]) to (Subscript[ζ, 1]) (Subscript[ζ, 2]) .

Also let’s use the paper’s [1] substitution for parameters, check and see if we got the same matrix:

One of our solutions matches the paper [1] EQ (55) for Case I:

RGrassmann=R/.{a->aa, b->bb, c->cc, d->dd, p->pp, q->qq};
RGrassmann3=Flatten[RGrassmann/.{solCaseI[[3]]},1];
RGrassmann3/.{(Subscript[a, 0])->0,(Subscript[d, 0])->0,(Subscript[b, 0])->(t^2)/r,(Subscript[p, 0])->t, (Subscript[q, 0])->t, (Subscript[c, 0])->r, (Subscript[c, 12])->v, (Subscript[b, 12])->w, (Subscript[d, 12])->y, (Subscript[p, 12])->l, (Subscript[q, 12])->m, (Subscript[a, 12])->n,(Subscript[ζ, 1])⋀(Subscript[ζ, 2])->(Subscript[ζ, 1])(Subscript[ζ, 2])}//MatrixForm

Let’s tabulate all the solutions for Case I:

Column[Table[RGrassmann=R/.{a->aa, b->bb, c->cc, d->dd, p->pp, q->qq};
RGrassmannFinal=Flatten[RGrassmann/.{solCaseI[[i]]},1];
RGrassmannFinal/.{(Subscript[a, 0])->0,(Subscript[d, 0])->0,(Subscript[b, 0])->(t^2)/r,(Subscript[p, 0])->t, (Subscript[q, 0])->t, (Subscript[c, 0])->r, (Subscript[c, 12])->v, (Subscript[b, 12])->w, (Subscript[d, 12])->y, (Subscript[p, 12])->l, (Subscript[q, 12])->m, (Subscript[a, 12])->n,(Subscript[ζ, 1])⋀(Subscript[ζ, 2])->(Subscript[ζ, 1])(Subscript[ζ, 2])}//MatrixForm,
{i, 1, Length[solCaseI]}]]

Case 2:  Compare with [1]:

(* exactly 9 equations *)
caseII=DeleteCases[DeleteDuplicates[coeffSystem/.{(Subscript[a, 0])->0}], _Integer]
Length[caseII]

Since (Subscript[a, 12])(Subscript[d, 0]^2) = 0 then (Subscript[d, 0]) = 0 this case coincides with the case I.

Case III:

Apparently [1] is missing two equations:

(* exactly 9 equations *)
caseIII=DeleteCases[DeleteDuplicates[coeffSystem/.{(Subscript[d, 0])->(Subscript[a, 0]), (Subscript[c, 0])->0, (Subscript[b, 0])->0}], _Integer]
Length[caseIII]

Let’s solve the system of equations:

solCaseIII=Solve[caseIII==0, scalars]

Compute the R matrices, see they match [1]:

Case III is not matching!

Column[Table[RGrassmann=R/.{a->aa, b->bb, c->cc, d->dd, p->pp, q->qq};
RGrassmannFinal=Flatten[RGrassmann/.{solCaseIII[[i]]},1];
RGrassmannFinal/.{(Subscript[b, 0])->0,(Subscript[a, 0])->0,(Subscript[d, 0])->0,(Subscript[p, 0])->t, (Subscript[q, 0])->r, (Subscript[c, 0])->0, (Subscript[a, 12])->l, (Subscript[q, 12])->s, (Subscript[p, 12])->w, (Subscript[b, 12])->m,(Subscript[c, 12])->n,(Subscript[d, 12])->k,(Subscript[ζ, 1])⋀(Subscript[ζ, 2])->(Subscript[ζ, 1])(Subscript[ζ, 2])}//MatrixForm,
{i, 1, Length[solCaseIII]}]]

Finite Fields:
Modulus Arithmetic

(Subscript[ℤ, 2])

System Parameters need to be increased for Solver:

SetSystemOptions["ReduceOptions"->"MaxModularPoints"->100000000];

solCaseI=DeleteDuplicates[Solve[caseI==0, scalars,Modulus->2]];

Length[solCaseI]

randIndex=RandomInteger[{1,Length[solCaseI]}, 100 ];
DeleteDuplicates[Table[RGrassmann=R/.{a->aa, b->bb, c->cc, d->dd, p->pp, q->qq};
RGrassmannFinal=Flatten[RGrassmann/.{solCaseI[[randIndex[[i]]]]},1];
Style[RGrassmannFinal/.{(Subscript[a, 0])->0,(Subscript[d, 0])->0,(Subscript[b, 0])->0,(Subscript[p, 0])->t, (Subscript[q, 0])->t, (Subscript[c, 0])->0, (Subscript[c, 12])->v, (Subscript[b, 12])->w, (Subscript[d, 12])->y, (Subscript[p, 12])->l, (Subscript[q, 12])->m, (Subscript[a, 12])->n,(Subscript[ζ, 1])⋀(Subscript[ζ, 2])->(Subscript[ζ, 1])(Subscript[ζ, 2]),(Subscript[ζ, 1])⋀(Subscript[ζ, 3])->(Subscript[ζ, 1])(Subscript[ζ, 3]),(Subscript[ζ, 2])⋀(Subscript[ζ, 3])->(Subscript[ζ, 2])(Subscript[ζ, 3])}//MatrixForm,FontSize->7],
{i,1, 100}]]

(Subscript[ℤ, 3])

SetSystemOptions["ReduceOptions"->"MaxModularPoints"->100000000];

solCaseI=DeleteDuplicates[Solve[caseI==0, scalars,Modulus->3]];

Length[solCaseI]

Output some random 100 solutions:

randIndex=RandomInteger[{1,Length[solCaseI]}, 100 ];
DeleteDuplicates[Table[RGrassmann=R/.{a->aa, b->bb, c->cc, d->dd, p->pp, q->qq};
RGrassmannFinal=Flatten[RGrassmann/.{solCaseI[[randIndex[[i]]]]},1];
Style[RGrassmannFinal/.{(Subscript[a, 0])->0,(Subscript[d, 0])->0,(Subscript[b, 0])->0,(Subscript[p, 0])->t, (Subscript[q, 0])->t, (Subscript[c, 0])->0, (Subscript[c, 12])->v, (Subscript[b, 12])->w, (Subscript[d, 12])->y, (Subscript[p, 12])->l, (Subscript[q, 12])->m, (Subscript[a, 12])->n,(Subscript[ζ, 1])⋀(Subscript[ζ, 2])->(Subscript[ζ, 1])(Subscript[ζ, 2]),(Subscript[ζ, 1])⋀(Subscript[ζ, 3])->(Subscript[ζ, 1])(Subscript[ζ, 3]),(Subscript[ζ, 2])⋀(Subscript[ζ, 3])->(Subscript[ζ, 2])(Subscript[ζ, 3])}//MatrixForm,FontSize->7],
{i,1, 100}]]

(Subscript[ℤ, 4])

SetSystemOptions["ReduceOptions"->"MaxModularPoints"->100000000];

solCaseI=DeleteDuplicates[Solve[caseI==0, scalars,Modulus->4]];

Length[solCaseI]

Output some random 100 solutions:

randIndex=RandomInteger[{1,Length[solCaseI]}, 100 ];
DeleteDuplicates[Table[RGrassmann=R/.{a->aa, b->bb, c->cc, d->dd, p->pp, q->qq};
RGrassmannFinal=Flatten[RGrassmann/.{solCaseI[[randIndex[[i]]]]},1];
Style[RGrassmannFinal/.{(Subscript[a, 0])->0,(Subscript[d, 0])->0,(Subscript[b, 0])->0,(Subscript[p, 0])->t, (Subscript[q, 0])->t, (Subscript[c, 0])->0, (Subscript[c, 12])->v, (Subscript[b, 12])->w, (Subscript[d, 12])->y, (Subscript[p, 12])->l, (Subscript[q, 12])->m, (Subscript[a, 12])->n,(Subscript[ζ, 1])⋀(Subscript[ζ, 2])->(Subscript[ζ, 1])(Subscript[ζ, 2]),(Subscript[ζ, 1])⋀(Subscript[ζ, 3])->(Subscript[ζ, 1])(Subscript[ζ, 3]),(Subscript[ζ, 2])⋀(Subscript[ζ, 3])->(Subscript[ζ, 2])(Subscript[ζ, 3])}//MatrixForm,FontSize->7],
{i,1, 100}]]

(Subscript[ℤ, 5])

SetSystemOptions["ReduceOptions"->"MaxModularPoints"->100000000];

solCaseI=DeleteDuplicates[Solve[caseI==0, scalars,Modulus->5]];

Length[solCaseI]

Output some random 100 solutions:

randIndex=RandomInteger[{1,Length[solCaseI]}, 100 ];
DeleteDuplicates[Table[RGrassmann=R/.{a->aa, b->bb, c->cc, d->dd, p->pp, q->qq};
RGrassmannFinal=Flatten[RGrassmann/.{solCaseI[[randIndex[[i]]]]},1];
Style[RGrassmannFinal/.{(Subscript[a, 0])->0,(Subscript[d, 0])->0,(Subscript[b, 0])->0,(Subscript[p, 0])->t, (Subscript[q, 0])->t, (Subscript[c, 0])->0, (Subscript[c, 12])->v, (Subscript[b, 12])->w, (Subscript[d, 12])->y, (Subscript[p, 12])->l, (Subscript[q, 12])->m, (Subscript[a, 12])->n,(Subscript[ζ, 1])⋀(Subscript[ζ, 2])->(Subscript[ζ, 1])(Subscript[ζ, 2]),(Subscript[ζ, 1])⋀(Subscript[ζ, 3])->(Subscript[ζ, 1])(Subscript[ζ, 3]),(Subscript[ζ, 2])⋀(Subscript[ζ, 3])->(Subscript[ζ, 2])(Subscript[ζ, 3])}//MatrixForm,FontSize->7],
{i,1, 100}]]