QYBE solutions for constant R-Matrices over Grassmann Algebra (Even)



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

Prelude 

This treatise is an investigation into the deployment of Grassmann Algebra over Reals and Finite Fields to assess the feasibility of its application to the Yang-Baxter solutions. 

As it has turned out YBE solutions, in thousands of papers since 1960s, are more or less a few fundamental ones and mostly over the Real numbers. 

We are hoping the treatise below, mostly code, can help a researcher to learn the underlying algebraic operations in speedy fashion as well as the algorithms involved in solving the systems of non-linear equations. 

In traditional research the code is always a side thing some did to solve more complex situations numerically. In our approach, both symbolic and numeric code has been used, with the manifesto Code = Theory as opposed to the traditional views. 

The latter is difficult to adopt given the current academic education and old fashioned attitudes.

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:

Grassmann Algebra 2 generators

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]}]]

Grassmann Algebra 3 generators

★A;DeclareVectorSymbols[(Subscript[ζ, 1]),(Subscript[ζ, 2]),(Subscript[ζ, 3])]
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]),(Subscript[a, 13]),(Subscript[b, 13]),(Subscript[c, 13]),(Subscript[d, 13]),(Subscript[p, 13]),(Subscript[q, 13]),(Subscript[a, 23]),(Subscript[b, 23]),(Subscript[c, 23]),(Subscript[d, 23]),(Subscript[p, 23]),(Subscript[q, 23])]
X=★𝒢[(1+(Subscript[ζ, 1]))⋀(1+(Subscript[ζ, 2]))⋀(1+(Subscript[ζ, 3]))]

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

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

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

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

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

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

expr1=GrassmannExpandAndSimplify[cc⋀dd⋀aa]

Collect the coefficients:

coeff1=Flatten[{(Subscript[a, 0]) (Subscript[c, 0]) (Subscript[d, 0]),Coefficient[expr1, {(Subscript[ζ, 1])⋀(Subscript[ζ, 2])}], Coefficient[expr1, {(Subscript[ζ, 1])⋀(Subscript[ζ, 3])}], Coefficient[expr1, {(Subscript[ζ, 2])⋀(Subscript[ζ, 3])}]}]

expr2=GrassmannExpandAndSimplify[bb⋀dd⋀aa]

coeff2=Flatten[{(Subscript[a, 0]) (Subscript[b, 0]) (Subscript[d, 0]),Coefficient[expr2, {(Subscript[ζ, 1])⋀(Subscript[ζ, 2])}], Coefficient[expr2, {(Subscript[ζ, 1])⋀(Subscript[ζ, 3])}], Coefficient[expr2, {(Subscript[ζ, 2])⋀(Subscript[ζ, 3])}]}]

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

coeff3=Flatten[{-(Subscript[a, 0]^2) (Subscript[d, 0])+(Subscript[a, 0]) (Subscript[d, 0]^2),Coefficient[expr3, {(Subscript[ζ, 1])⋀(Subscript[ζ, 2])}], Coefficient[expr3, {(Subscript[ζ, 1])⋀(Subscript[ζ, 3])}], Coefficient[expr3, {(Subscript[ζ, 2])⋀(Subscript[ζ, 3])}]}]

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

coeff4=Flatten[{(Subscript[b, 0]) (Subscript[c, 0]) (Subscript[d, 0])+(Subscript[d, 0]^2) (Subscript[p, 0])-(Subscript[d, 0]) (Subscript[p, 0]^2),Coefficient[expr4, {(Subscript[ζ, 1])⋀(Subscript[ζ, 2])}], Coefficient[expr4, {(Subscript[ζ, 1])⋀(Subscript[ζ, 3])}], Coefficient[expr4, {(Subscript[ζ, 2])⋀(Subscript[ζ, 3])}]}]

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

coeff5=Flatten[{(Subscript[b, 0]) (Subscript[c, 0]) (Subscript[d, 0])+(Subscript[d, 0]^2) (Subscript[q, 0])-(Subscript[d, 0]) (Subscript[q, 0]^2),Coefficient[expr5, {(Subscript[ζ, 1])⋀(Subscript[ζ, 2])}], Coefficient[expr5, {(Subscript[ζ, 1])⋀(Subscript[ζ, 3])}], Coefficient[expr5, {(Subscript[ζ, 2])⋀(Subscript[ζ, 3])}]}]

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

coeff6=Flatten[{(Subscript[a, 0]) (Subscript[b, 0]) (Subscript[c, 0])+(Subscript[a, 0]^2) (Subscript[p, 0])-(Subscript[a, 0]) (Subscript[p, 0]^2),Coefficient[expr6, {(Subscript[ζ, 1])⋀(Subscript[ζ, 2])}], Coefficient[expr6, {(Subscript[ζ, 1])⋀(Subscript[ζ, 3])}], Coefficient[expr6, {(Subscript[ζ, 2])⋀(Subscript[ζ, 3])}]}]

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

coeff7=Flatten[{(Subscript[a, 0]) (Subscript[b, 0]) (Subscript[c, 0])+(Subscript[a, 0]^2) (Subscript[q, 0])-(Subscript[a, 0]) (Subscript[q, 0]^2),Coefficient[expr7, {(Subscript[ζ, 1])⋀(Subscript[ζ, 2])}], Coefficient[expr7, {(Subscript[ζ, 1])⋀(Subscript[ζ, 3])}], Coefficient[expr7, {(Subscript[ζ, 2])⋀(Subscript[ζ, 3])}]}]

coeffSystem = DeleteDuplicates[Simplify[Join[coeff1, coeff2, coeff3,coeff4,coeff5,coeff6,coeff7]]]
Length[coeffSystem]

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

solCaseI=Solve[caseI==0, scalars]

Column[Table[RGrassmann=R/.{a->aa, b->bb, c->cc, d->dd, p->pp, q->qq};
RGrassmannFinal=Flatten[RGrassmann/.{solCaseI[[i]]},1];
Style[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]),(Subscript[ζ, 1])⋀(Subscript[ζ, 3])->(Subscript[ζ, 1])(Subscript[ζ, 3]),(Subscript[ζ, 2])⋀(Subscript[ζ, 3])->(Subscript[ζ, 2])(Subscript[ζ, 3])}//MatrixForm,FontSize->6],
{i, 1, Length[solCaseI]}]]

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

solCaseIII=Solve[caseIII==0, scalars]

Column[Table[RGrassmann=R/.{a->aa, b->bb, c->cc, d->dd, p->pp, q->qq};
RGrassmannFinal=Flatten[RGrassmann/.{solCaseIII[[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->6],
{i, 1, Length[solCaseIII]}]]

Grassmann Algebra 4 generators

★A;DeclareVectorSymbols[(Subscript[ζ, 1]),(Subscript[ζ, 2]),(Subscript[ζ, 3]),(Subscript[ζ, 4])]
(* Dimension has to be set or the default is 3 *)
DeclareBasis[4];
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]),(Subscript[a, 13]),(Subscript[a, 14]),(Subscript[b, 13]),(Subscript[b, 14]),(Subscript[c, 13]),(Subscript[c, 14]),(Subscript[d, 13]),(Subscript[d, 14]),(Subscript[p, 13]),(Subscript[p, 14]),(Subscript[q, 13]),(Subscript[q, 14]),(Subscript[a, 23]),(Subscript[b, 23]),(Subscript[c, 23]),(Subscript[d, 23]),(Subscript[p, 23]),(Subscript[q, 23]),(Subscript[a, 24]),(Subscript[a, 34]),(Subscript[a, 1234]),(Subscript[b, 24]),(Subscript[b, 34]),(Subscript[b, 1234]),(Subscript[c, 24]),(Subscript[c, 34]),(Subscript[c, 1234]),(Subscript[d, 24]),(Subscript[d, 34]),(Subscript[d, 1234]),(Subscript[p, 24]),(Subscript[p, 34]),(Subscript[p, 1234]),(Subscript[q, 24]),(Subscript[q, 34]),(Subscript[q, 1234])]
X=★𝒢[(1+(Subscript[ζ, 1]))⋀(1+(Subscript[ζ, 2]))⋀(1+(Subscript[ζ, 3]))⋀(1+(Subscript[ζ, 4]))]

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

bb=.;
bb={(Subscript[b, 0]),0,0,0,0,(Subscript[b, 12]),(Subscript[b, 13]),(Subscript[b, 14]),(Subscript[b, 23]) ,(Subscript[b, 24]),(Subscript[b, 34]),0,0,0,0,(Subscript[b, 1234])}.List@@X

cc=.;
cc={(Subscript[c, 0]),0,0,0,0,(Subscript[c, 12]),(Subscript[c, 13]),(Subscript[c, 14]),(Subscript[c, 23]) ,(Subscript[c, 24]),(Subscript[c, 34]),0,0,0,0,(Subscript[c, 1234])}.List@@X

dd=.;
dd={(Subscript[d, 0]),0,0,0,0,(Subscript[d, 12]),(Subscript[d, 13]),(Subscript[d, 14]),(Subscript[d, 23]) ,(Subscript[d, 24]),(Subscript[d, 34]),0,0,0,0,(Subscript[d, 1234])}.List@@X

pp=.;
pp={(Subscript[p, 0]),0,0,0,0,(Subscript[p, 12]),(Subscript[p, 13]),(Subscript[p, 14]),(Subscript[p, 23]) ,(Subscript[p, 24]),(Subscript[p, 34]),0,0,0,0,(Subscript[p, 1234])}.List@@X

qq=.;
qq={(Subscript[q, 0]),0,0,0,0,(Subscript[q, 12]),(Subscript[q, 13]),(Subscript[q, 14]),(Subscript[q, 23]) ,(Subscript[q, 24]),(Subscript[q, 34]),0,0,0,0,(Subscript[q, 1234])}.List@@X

expr1=GrassmannExpandAndSimplify[cc⋀dd⋀aa]

Collect the coefficients:

coeff1=Flatten[{(Subscript[a, 0]) (Subscript[c, 0]) (Subscript[d, 0]),Coefficient[expr1, {(Subscript[ζ, 1])⋀(Subscript[ζ, 2])}], Coefficient[expr1, {(Subscript[ζ, 1])⋀(Subscript[ζ, 3])}],Coefficient[expr1, {(Subscript[ζ, 1])⋀(Subscript[ζ, 4])}], Coefficient[expr1, {(Subscript[ζ, 2])⋀(Subscript[ζ, 3])}],Coefficient[expr1, {(Subscript[ζ, 2])⋀(Subscript[ζ, 4])}],Coefficient[expr1, {(Subscript[ζ, 3])⋀(Subscript[ζ, 4])}],Coefficient[expr1, {(Subscript[ζ, 1])⋀(Subscript[ζ, 2])⋀(Subscript[ζ, 3])⋀(Subscript[ζ, 4])}]}]

expr2=GrassmannExpandAndSimplify[bb⋀dd⋀aa]

coeff2=Flatten[{(Subscript[a, 0]) (Subscript[b, 0]) (Subscript[d, 0]),Coefficient[expr2, {(Subscript[ζ, 1])⋀(Subscript[ζ, 2])}], Coefficient[expr2, {(Subscript[ζ, 1])⋀(Subscript[ζ, 3])}],Coefficient[expr2, {(Subscript[ζ, 1])⋀(Subscript[ζ, 4])}], Coefficient[expr2, {(Subscript[ζ, 2])⋀(Subscript[ζ, 3])}],Coefficient[expr2, {(Subscript[ζ, 2])⋀(Subscript[ζ, 4])}],Coefficient[expr2, {(Subscript[ζ, 3])⋀(Subscript[ζ, 4])}],Coefficient[expr2, {(Subscript[ζ, 1])⋀(Subscript[ζ, 2])⋀(Subscript[ζ, 3])⋀(Subscript[ζ, 4])}]}]

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

coeff3=Flatten[{-(Subscript[a, 0]^2) (Subscript[d, 0])+(Subscript[a, 0]) (Subscript[d, 0]^2),Coefficient[expr3, {(Subscript[ζ, 1])⋀(Subscript[ζ, 2])}], Coefficient[expr3, {(Subscript[ζ, 1])⋀(Subscript[ζ, 3])}],Coefficient[expr3, {(Subscript[ζ, 1])⋀(Subscript[ζ, 4])}], Coefficient[expr3, {(Subscript[ζ, 2])⋀(Subscript[ζ, 3])}],Coefficient[expr3, {(Subscript[ζ, 2])⋀(Subscript[ζ, 4])}],Coefficient[expr3, {(Subscript[ζ, 3])⋀(Subscript[ζ, 4])}],Coefficient[expr3, {(Subscript[ζ, 1])⋀(Subscript[ζ, 2])⋀(Subscript[ζ, 3])⋀(Subscript[ζ, 4])}]}]

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

coeff4=Flatten[{(Subscript[b, 0]) (Subscript[c, 0]) (Subscript[d, 0])+(Subscript[d, 0]^2) (Subscript[p, 0])-(Subscript[d, 0]) (Subscript[p, 0]^2),Coefficient[expr4, {(Subscript[ζ, 1])⋀(Subscript[ζ, 2])}], Coefficient[expr4, {(Subscript[ζ, 1])⋀(Subscript[ζ, 3])}],Coefficient[expr4, {(Subscript[ζ, 1])⋀(Subscript[ζ, 4])}], Coefficient[expr4, {(Subscript[ζ, 2])⋀(Subscript[ζ, 3])}],Coefficient[expr4, {(Subscript[ζ, 2])⋀(Subscript[ζ, 4])}],Coefficient[expr4, {(Subscript[ζ, 3])⋀(Subscript[ζ, 4])}],Coefficient[expr4, {(Subscript[ζ, 1])⋀(Subscript[ζ, 2])⋀(Subscript[ζ, 3])⋀(Subscript[ζ, 4])}]}]

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

coeff5=Flatten[{(Subscript[b, 0]) (Subscript[c, 0]) (Subscript[d, 0])+(Subscript[d, 0]^2) (Subscript[q, 0])-(Subscript[d, 0]) (Subscript[q, 0]^2),Coefficient[expr5, {(Subscript[ζ, 1])⋀(Subscript[ζ, 2])}], Coefficient[expr5, {(Subscript[ζ, 1])⋀(Subscript[ζ, 3])}],Coefficient[expr5, {(Subscript[ζ, 1])⋀(Subscript[ζ, 4])}], Coefficient[expr5, {(Subscript[ζ, 2])⋀(Subscript[ζ, 3])}],Coefficient[expr5, {(Subscript[ζ, 2])⋀(Subscript[ζ, 4])}],Coefficient[expr5, {(Subscript[ζ, 3])⋀(Subscript[ζ, 4])}],Coefficient[expr5, {(Subscript[ζ, 1])⋀(Subscript[ζ, 2])⋀(Subscript[ζ, 3])⋀(Subscript[ζ, 4])}]}]

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

coeff6=Flatten[{(Subscript[a, 0]) (Subscript[b, 0]) (Subscript[c, 0])+(Subscript[a, 0]^2) (Subscript[p, 0])-(Subscript[a, 0]) (Subscript[p, 0]^2),Coefficient[expr6, {(Subscript[ζ, 1])⋀(Subscript[ζ, 2])}], Coefficient[expr6, {(Subscript[ζ, 1])⋀(Subscript[ζ, 3])}],Coefficient[expr6, {(Subscript[ζ, 1])⋀(Subscript[ζ, 4])}], Coefficient[expr6, {(Subscript[ζ, 2])⋀(Subscript[ζ, 3])}],Coefficient[expr6, {(Subscript[ζ, 2])⋀(Subscript[ζ, 4])}],Coefficient[expr6, {(Subscript[ζ, 3])⋀(Subscript[ζ, 4])}],Coefficient[expr6, {(Subscript[ζ, 1])⋀(Subscript[ζ, 2])⋀(Subscript[ζ, 3])⋀(Subscript[ζ, 4])}]}]

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

coeff7=Flatten[{(Subscript[a, 0]) (Subscript[b, 0]) (Subscript[c, 0])+(Subscript[a, 0]^2) (Subscript[q, 0])-(Subscript[a, 0]) (Subscript[q, 0]^2),Coefficient[expr7, {(Subscript[ζ, 1])⋀(Subscript[ζ, 2])}], Coefficient[expr7, {(Subscript[ζ, 1])⋀(Subscript[ζ, 3])}],Coefficient[expr7, {(Subscript[ζ, 1])⋀(Subscript[ζ, 4])}], Coefficient[expr7, {(Subscript[ζ, 2])⋀(Subscript[ζ, 3])}],Coefficient[expr7, {(Subscript[ζ, 2])⋀(Subscript[ζ, 4])}],Coefficient[expr7, {(Subscript[ζ, 3])⋀(Subscript[ζ, 4])}],Coefficient[expr7, {(Subscript[ζ, 1])⋀(Subscript[ζ, 2])⋀(Subscript[ζ, 3])⋀(Subscript[ζ, 4])}]}]

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

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

Case I: (Subscript[c, 0])->0,(Subscript[b, 0])->0,(Subscript[d, 0])->(Subscript[a, 0]), (Subscript[q, 0])->(Subscript[a, 0]), (Subscript[p, 0])->(Subscript[a, 0])

solCaseI=Solve[caseI==0, scalars]

(* (Subscript[ζ, 1])⋀(Subscript[ζ, 2])⋀(Subscript[ζ, 3])⋀(Subscript[ζ, 4])->(Subscript[ζ, 1])(Subscript[ζ, 2])(Subscript[ζ, 3])(Subscript[ζ, 4]) has to be first in the list of subs *)
Column[Table[RGrassmann=R/.{a->aa, b->bb, c->cc, d->dd, p->pp, q->qq};
RGrassmannFinal=Flatten[RGrassmann/.{solCaseI[[i]]},1];
Style[RGrassmannFinal/.{(Subscript[ζ, 1])⋀(Subscript[ζ, 2])⋀(Subscript[ζ, 3])⋀(Subscript[ζ, 4])->(Subscript[ζ, 1])(Subscript[ζ, 2])(Subscript[ζ, 3])(Subscript[ζ, 4]),(Subscript[ζ, 1])⋀(Subscript[ζ, 2])->(Subscript[ζ, 1])(Subscript[ζ, 2]),(Subscript[ζ, 1])⋀(Subscript[ζ, 3])->(Subscript[ζ, 1])(Subscript[ζ, 3]),(Subscript[ζ, 2])⋀(Subscript[ζ, 3])->(Subscript[ζ, 2])(Subscript[ζ, 3]),(Subscript[ζ, 2])⋀(Subscript[ζ, 4])->(Subscript[ζ, 2])(Subscript[ζ, 4]),(Subscript[ζ, 1])⋀(Subscript[ζ, 4])->(Subscript[ζ, 1])(Subscript[ζ, 4]),(Subscript[ζ, 3])⋀(Subscript[ζ, 4])->(Subscript[ζ, 3])(Subscript[ζ, 4])}//MatrixForm,FontSize->6],
{i, 1, Length[solCaseI]}]]

caseII=DeleteCases[DeleteDuplicates[coeffSystem//.{(Subscript[a, 0])->0,(Subscript[d, 0])->(Subscript[a, 0]), (Subscript[q, 0])->(Subscript[a, 0]), (Subscript[p, 0])->(Subscript[a, 0])}], _Integer]
Length[caseII]

Let’s assume (Subscript[b, 0]) and (Subscript[c, 0]) are non-zero:

Factor[caseII]

caseII1 =DeleteDuplicates[ { ((Subscript[a, 34]) (Subscript[d, 12])-(Subscript[a, 24]) (Subscript[d, 13])+(Subscript[a, 23]) (Subscript[d, 14])+(Subscript[a, 14]) (Subscript[d, 23])-(Subscript[a, 13]) (Subscript[d, 24])+(Subscript[a, 12]) (Subscript[d, 34])),((Subscript[a, 34]) (Subscript[d, 12])-(Subscript[a, 24]) (Subscript[d, 13])+(Subscript[a, 23]) (Subscript[d, 14])+(Subscript[a, 14]) (Subscript[d, 23])-(Subscript[a, 13]) (Subscript[d, 24])+(Subscript[a, 12]) (Subscript[d, 34])),(Subscript[b, 0]) (Subscript[c, 0]) (Subscript[d, 12]),(Subscript[b, 0]) (Subscript[c, 0]) (Subscript[d, 13]),(Subscript[b, 0]) (Subscript[c, 0]) (Subscript[d, 14]),(Subscript[b, 0]) (Subscript[c, 0]) (Subscript[d, 23]),(Subscript[b, 0]) (Subscript[c, 0]) (Subscript[d, 24]),(Subscript[b, 0]) (Subscript[c, 0]) (Subscript[d, 34]),(Subscript[b, 34]) (Subscript[c, 0]) (Subscript[d, 12])+(Subscript[b, 0]) (Subscript[c, 34]) (Subscript[d, 12])-(Subscript[b, 24]) (Subscript[c, 0]) (Subscript[d, 13])-(Subscript[b, 0]) (Subscript[c, 24]) (Subscript[d, 13])+(Subscript[b, 23]) (Subscript[c, 0]) (Subscript[d, 14])+(Subscript[b, 0]) (Subscript[c, 23]) (Subscript[d, 14])+(Subscript[b, 14]) (Subscript[c, 0]) (Subscript[d, 23])+(Subscript[b, 0]) (Subscript[c, 14]) (Subscript[d, 23])-(Subscript[b, 13]) (Subscript[c, 0]) (Subscript[d, 24])-(Subscript[b, 0]) (Subscript[c, 13]) (Subscript[d, 24])+(Subscript[b, 12]) (Subscript[c, 0]) (Subscript[d, 34])+(Subscript[b, 0]) (Subscript[c, 12]) (Subscript[d, 34])+(Subscript[b, 0]) (Subscript[c, 0]) (Subscript[d, 1234]),(Subscript[a, 12]) (Subscript[b, 0]) (Subscript[c, 0]),(Subscript[a, 13]) (Subscript[b, 0]) (Subscript[c, 0]),(Subscript[a, 14]) (Subscript[b, 0]) (Subscript[c, 0]),(Subscript[a, 23]) (Subscript[b, 0]) (Subscript[c, 0]),(Subscript[a, 24]) (Subscript[b, 0]) (Subscript[c, 0]),(Subscript[a, 34]) (Subscript[b, 0]) (Subscript[c, 0]),(Subscript[a, 1234]) (Subscript[b, 0]) (Subscript[c, 0])+(Subscript[a, 34]) (Subscript[b, 12]) (Subscript[c, 0])-(Subscript[a, 24]) (Subscript[b, 13]) (Subscript[c, 0])+(Subscript[a, 23]) (Subscript[b, 14]) (Subscript[c, 0])+(Subscript[a, 14]) (Subscript[b, 23]) (Subscript[c, 0])-(Subscript[a, 13]) (Subscript[b, 24]) (Subscript[c, 0])+(Subscript[a, 12]) (Subscript[b, 34]) (Subscript[c, 0])+(Subscript[a, 34]) (Subscript[b, 0]) (Subscript[c, 12])-(Subscript[a, 24]) (Subscript[b, 0]) (Subscript[c, 13])+(Subscript[a, 23]) (Subscript[b, 0]) (Subscript[c, 14])+(Subscript[a, 14]) (Subscript[b, 0]) (Subscript[c, 23])-(Subscript[a, 13]) (Subscript[b, 0]) (Subscript[c, 24])+(Subscript[a, 12]) (Subscript[b, 0]) (Subscript[c, 34])}]

We get a simple solution where (Subscript[b, 0])->0, (Subscript[c, 0])->0 which is against our assumptions, and (Subscript[a, 1234])->0,(Subscript[d, 1234])->0 which is not a desirable solution since we need to be of 4th degree  , see following:

solCaseII1=Solve[(caseII1/.{(Subscript[d, 12])->0,(Subscript[d, 13])->0,(Subscript[d, 14])->0,(Subscript[d, 23])->0,(Subscript[d, 24])->0,(Subscript[d, 34])->0,(Subscript[a, 12])->0,(Subscript[a, 13])->0,(Subscript[a, 14])->0,(Subscript[a, 23])->0,(Subscript[a, 24])->0,(Subscript[a, 34])->0})==0, scalars]

Let’s go back and assume (Subscript[b, 0])->0 and (Subscript[c, 0]) non-zero:

caseII2=DeleteCases[DeleteDuplicates[coeffSystem//.{(Subscript[a, 0])->0,(Subscript[d, 0])->(Subscript[a, 0]), (Subscript[q, 0])->(Subscript[a, 0]), (Subscript[p, 0])->(Subscript[a, 0]),(Subscript[b, 0])->0}], _Integer]

Factor[caseII2]

Remove (Subscript[c, 0]):

caseII2=DeleteDuplicates[{ ((Subscript[a, 34]) (Subscript[d, 12])-(Subscript[a, 24]) (Subscript[d, 13])+(Subscript[a, 23]) (Subscript[d, 14])+(Subscript[a, 14]) (Subscript[d, 23])-(Subscript[a, 13]) (Subscript[d, 24])+(Subscript[a, 12]) (Subscript[d, 34])), ((Subscript[b, 34]) (Subscript[d, 12])-(Subscript[b, 24]) (Subscript[d, 13])+(Subscript[b, 23]) (Subscript[d, 14])+(Subscript[b, 14]) (Subscript[d, 23])-(Subscript[b, 13]) (Subscript[d, 24])+(Subscript[b, 12]) (Subscript[d, 34])),((Subscript[a, 34]) (Subscript[b, 12])-(Subscript[a, 24]) (Subscript[b, 13])+(Subscript[a, 23]) (Subscript[b, 14])+(Subscript[a, 14]) (Subscript[b, 23])-(Subscript[a, 13]) (Subscript[b, 24])+(Subscript[a, 12]) (Subscript[b, 34])) }]

Too few equations but we can find nice enough relationship between them for parametric solutions:

solCaseII2=Solve[caseII2==0, {(Subscript[a, 34]),(Subscript[b, 34]),(Subscript[a, 24])}]

Let’s go back and assume (Subscript[c, 0])->0 and (Subscript[b, 0]) non-zero:

caseII3=DeleteCases[DeleteDuplicates[coeffSystem//.{(Subscript[a, 0])->0,(Subscript[d, 0])->(Subscript[a, 0]), (Subscript[q, 0])->(Subscript[a, 0]), (Subscript[p, 0])->(Subscript[a, 0]),(Subscript[c, 0])->0}], _Integer]

Factor[caseII3]

Remove (Subscript[b, 0]) :

caseII3=DeleteDuplicates[{  ((Subscript[a, 34]) (Subscript[d, 12])-(Subscript[a, 24]) (Subscript[d, 13])+(Subscript[a, 23]) (Subscript[d, 14])+(Subscript[a, 14]) (Subscript[d, 23])-(Subscript[a, 13]) (Subscript[d, 24])+(Subscript[a, 12]) (Subscript[d, 34])), ((Subscript[c, 34]) (Subscript[d, 12])-(Subscript[c, 24]) (Subscript[d, 13])+(Subscript[c, 23]) (Subscript[d, 14])+(Subscript[c, 14]) (Subscript[d, 23])-(Subscript[c, 13]) (Subscript[d, 24])+(Subscript[c, 12]) (Subscript[d, 34])), ((Subscript[a, 34]) (Subscript[c, 12])-(Subscript[a, 24]) (Subscript[c, 13])+(Subscript[a, 23]) (Subscript[c, 14])+(Subscript[a, 14]) (Subscript[c, 23])-(Subscript[a, 13]) (Subscript[c, 24])+(Subscript[a, 12]) (Subscript[c, 34])) }]

Too few equations but we can find nice enough relationship between them for parametric solutions:

solCaseII3=Solve[caseII3==0, {(Subscript[a, 34]),(Subscript[c, 34]),(Subscript[a, 24])}]

Finite Fields:
Modulus Arithmetic

Experimenting with Finite Fields and below using the Modulus 5 Arithmetic was able to solve the YBE for 6-vertex system of equation.

Used the Grassmann Algebra all the way to the systems of equations but limited the Solver to the Modulus 5. In effect, we solved 6-vertex YBE for Grassmann Algebra with Modulus 5 scalars. 

First generate the Grassmann Algebra with 2 generators:

★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], to solve for the R matrix:

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])}]

coeffSystem = DeleteDuplicates[Simplify[Join[coeff1, coeff2, coeff3,coeff4,coeff5,coeff6,coeff7]]]
Length[coeffSystem]

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

System Parameters need to be increased for Solver:

SystemOptions["ReduceOptions"]

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

It runs about 5 mins on an IMAC and uses a couple of GIGs of physical memory:

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

Number of solutions very large:

Length[solCaseI]

Sample solutions for Modulus 5:

solCaseI[[1400]]
RGrassmann=R/.{a->aa, b->bb, c->cc, d->dd, p->pp, q->qq};
RGrassmannFinal=Flatten[RGrassmann/.{solCaseI[[1400]]},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

solCaseI[[10400]]
RGrassmann=R/.{a->aa, b->bb, c->cc, d->dd, p->pp, q->qq};
RGrassmannFinal=Flatten[RGrassmann/.{solCaseI[[10400]]},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

solCaseI[[1000000]]
RGrassmann=R/.{a->aa, b->bb, c->cc, d->dd, p->pp, q->qq};
RGrassmannFinal=Flatten[RGrassmann/.{solCaseI[[1000000]]},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

solCaseI[[1040000]]
RGrassmann=R/.{a->aa, b->bb, c->cc, d->dd, p->pp, q->qq};
RGrassmannFinal=Flatten[RGrassmann/.{solCaseI[[1040000]]},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

Increasing the modulus to more than 5 requires much larger memory, exceeding the 8GIG on my IMAC, perhaps 16G machine required. This memory consumption is due to the MaxModularPoints increase on Mathematica’s side:

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

Due to massive hard-drive paging and thrashing no solutions were obtained for larger modulus:

solCaseI=Solve[caseI==0, scalars,Modulus->7]

solCaseI=FindInstance[caseI==0,scalars,2,Modulus->7,RandomSeed->8010]

References 

[1] Steven Duplij, Olga Kotulska and Alexander Sadovnikov: http://homepages.spa.umn.edu/~duplij/publications/Duplij_JZUS-sd-kot-sad.pdf  

[2] John Browne,  https://sites.google.com/site/grassmannalgebra/