(* This Mathematica notebook checks that for a particular choice of a degeneration, the 21 x 21 monodromy matrices are linearly independent. The reduction step to this linear algebra computation is described in the paper "Kanev's uniformization..." by Alexeev et al.  *)

(* We are working in the Minkowski space I^{6,1} with the following inner product: *)
mdot[x_,y_]:=x[[7]]*y[[7]]-x[[1]]*y[[1]]-x[[2]]*y[[2]]-x[[3]]*y[[3]]-x[[4]]*y[[4]]-x[[5]]*y[[5]]-x[[6]]*y[[6]]

(* First, we define 27 lines on a cubic surface, as (-1)-vectors in the Minkowski space I^{6,1} *)
line=Table[0,{i,27},{j,7}];

s=1;   (* "s" stands for "sheet" *)
For[i=1,i≤6,i++, line[[s,i]]=1;s++]
For[i=1,i≤6,i++, 
line[[s,7]]=2;
For[k=1,k≤6,k++, If[k≠i,line[[s,k]]=-1]];
s++
]
For[i=1,i≤6,i++, 
For[j=i+1,j≤6,j++,
line[[s,7]]=1; line[[s,i]]=-1; line[[s,j]]=-1; s++]]
line//MatrixForm

(* Next, we define the 36 roots, as (-2)-vectors in I^{1,6} *)
root=Table[0,{i,36},{j,7}];
r=1;
For[i=1,i≤6,i++, 
For[j=i+1,j≤6,j++,
root[[r,i]]=1;root[[r,j]]=-1; r++]]
For[i=1,i≤6,i++, 
For[j=i+1,j≤6,j++,
For[k=j+1,k≤6,k++,
root[[r,7]]=1;root[[r,i]]=-1;root[[r,j]]=-1; root[[r,k]]=-1;r++]]]
root[[36,7]]=2; For[i=1,i≤6,i++, root[[36,i]]=-1];
root//MatrixForm

(* Prods is the matrix of intersection numbers between lines and roots, for self-check *)

Prods=Table[0,{i,36},{j,27}]; 
For[n=1,n≤36,n++, 
For[m=1,m≤27,m++,
 Prods[[n,m]]=mdot[ root[[n]],line[[m]] ] ]] 
Prods//MatrixForm

(* Now, we are getting to the computation itself *)
(* myroot is a table of 12 explicit vectors, the first 6 of which form a basis of E6 *)
myroot=Table[0,{i,12},{j,7}];
myroot[[1]]=root[[21]];
myroot[[2]]=root[[1]];
myroot[[3]]=root[[6]];
myroot[[4]]=root[[10]];
myroot[[5]]=root[[13]];
myroot[[6]]=root[[15]];
myroot[[7]]=root[[36]];
myroot[[8]]=root[[17]];
myroot[[9]]=root[[26]];
myroot[[10]]=root[[11]];
myroot[[11]]=root[[2]];
myroot[[12]]=root[[12]];
myroot//MatrixForm

(* Let us check that the first 6 vectors indeed form a basis of E6. We add vector (1,1,1,1,1,1,-3) to the first 6 vectors and check that the determinant of this 7x7 matrix is -3, as expected *)
first6rootsandk = Table[0,{i,7},{j,7}];
For[i=1,i≤6,i++, first6rootsandk[[i]]=myroot[[i]]   ]
first6rootsandk[[7]] = {1,1,1,1,1,1,-3};
Det[first6rootsandk]

(* ker = ker \oplus_{k=1}&{12} \to E6, which is identified with H_1(\Gamma,Z)^{-5}, as in Lemma 4.8  *)

ker=NullSpace[Transpose[myroot]];
ker//MatrixForm

(* Check: *)
ker . myroot//MatrixForm

(* p is the matrix associating to a root R_k, 1≤k≤12, the path in the tree T of Fig 1, consisting of edges e_i, 1≤i≤21 from the central point O to the ramification point labelled by R_k, as in Lemma 4.10 *)

p=Table[0,{i,21},{j,12}]; (* edges-to-endpoints *)

(* The rows are labeled A,A0,A1,A00,A01,A10,A11, B,B0,B1,B00,B01,B10,B11, C,C0,C1,C00,C01,C10,C11
A,B,C are the central branches, A0...C1 are the next 6 edges, A00...C11 are the next 12 edges *)

For[i=0,i<3,i++,
p[[7*i+1,4*i+1]]=p[[7*i+1,4*i+2]]=p[[7*i+1,4*i+3]]=p[[7*i+1,4*i+4]]=1; (* A B C *)
p[[7*i+2,4*i+1]]=p[[7*i+2,4*i+2]]=1; (* A0 B0 C0 *)
p[[7*i+3,4*i+3]]=p[[7*i+3,4*i+4]]=1; (* A1 B1 C1 *)
p[[7*i+4,4*i+1]]=1;(* A00 B00 C00 *)
p[[7*i+5,4*i+2]]=1;(* A01 B01 C01 *)
p[[7*i+6,4*i+3]]=1;(* A10 B10 C10 *)
p[[7*i+7,4*i+4]]=1 (* A11 B11 C11 *)]

p//MatrixForm

(* 21.27 inear forms (e_i^s)^* on the 12-dimensional space \oplus_{k=1}^{12}R_k, as in Lemma 4.10 *)
eis = Table[0,{i,21},{s,27},{k,12}];
For[i=1,i≤21,i++,
For[s=1,s≤27,s++,
For[k=1,k≤12,k++,
eis[[i,s,k]] = mdot[myroot[[k]],line[[s]]]  p[[i,k]]  ]]]

(* 21.27 linear forms = restrictions of (e_i^s)^* to ker \phi = rows of the matrix ker *)l=Table[0,{i,21},{s,27},{f,6}];
For[i=1,i≤21,i++,
For[s=1,s≤27,s++,
For[f=1,f≤6,f++,
l[[i,s,f]]=Sum[   eis[[i,s,k]]ker[[f,k]],{k,1,12}  ]    ]]]

(* 21.27 quadratic forms {(e_i^s)^*}^2 = l[i,s].Transpose(l[i,s]) *)
q=Table[0,{i,21},{s,27},{a,6},{b,6}];
For[i=1,i≤21,i++,
For[s=1,s≤27,s++,
For[a=1,a≤6,a++,
For[b=1,b≤6,b++,
q[[i,s,a,b]]=l[[i,s,a]]l[[i,s,b]]      ]]]]

(* 21 quadratic forms \sum_{s=1}^{27} {(e_i^s)^*}^2 / 6 *)
Q=Table[0,{i,21},{a,6},{b,6}];
For[i=1,i≤21,i++,
For[a=1,a≤6,a++,
For[b=1,b≤6,b++,
Q[[i,a,b]]=Sum[  q[[i,s,a,b]],{s,1,27}  ]/6     ]]]

(* Let us see them *)
For[i=1,i≤21,i++, matrix = Q[[i]]//MatrixForm; Print[matrix]  ]

(* Now convert these symmetric 6x6 matrices to vectors in Z^{21} *)
v=Table[0,{i,21},{n,21}];
For[i=1,i≤21,i++,
n=1;
For[a=1,a≤6,a++,
For[b=a,b≤6,b++,
v[[i,n]]=Q[[i,a,b]];
n++;        ]]   ]

(* Here are the 21 matrices as 21 vectors: *)
v//MatrixForm

(* Are they linearly indpendent? *)
MatrixRank[v]

Det[v]

2^12