(* Igor Klep and Markus Schweighofer *)
(* Addendum to ``Sums of hermitian squares and the BMV conjecture'' *)
(* July 31, 2008 *)

(*** S_{14,6}(X^2,Y^2) is a sum of hermitian squares and commutators ***)

(* matMult is an ad-hoc implementation of v^*Gv for a scalar Gram matrix G and a vector of words (of degree >1) in noncommuting (NC) variables v *)

matMult[mat_,vec_]:=Module[{tmpvec=Map[Reverse,vec]},
Sum[ mat[[i,j]] tmpvec[[i]].vec[[j]],{i,1,Length[vec]},{j,1,Length[vec]}]]

(* an example *)

matMult[{{0,0,-1},{-1,0,1},{0,0,0}},{x.x,y.y,x.y}]

(* S[m,k] gives the BMV polynomial S_{m,k}(x^2,y^2) *)

letterList[m_Integer,k_Integer]:=Join[Table[x.x,{m-k}],Table[y.y,{k}]]
words[m_Integer,k_Integer]:=Apply[Dot,Permutations[letterList[m,k]],2]
S[m_Integer,k_Integer]:=Apply[Plus,words[m,k]]

(* an example *)

S[3,1]

(* here are the three big matrices from the article *)

A[14,6]={{737/45,-13/10,247/90,497/90,497/90,497/90,-8/5,7/2,122/35,3/19,3/19,3/19,746/243,413/180,199/32},{-13/10,7/5,-7/15,-19/30,-19/30,-19/30,221/162,17/10,-17/20,5/4,5/4,5/4,-43/81,-48/49,413/180},{247/90,-7/15,3,0,0,0,-31/6,-392/81,5377/1215,175/972,175/972,175/972,1437/500,-43/81,746/243},{497/90,-19/30,0,7/3,7/3,7/3,235/247,227/90,-13/90,-1/2,-1/2,-1/2,175/972,5/4,3/19},{497/90,-19/30,0,7/3,7/3,7/3,235/247,227/90,-13/90,-1/2,-1/2,-1/2,175/972,5/4,3/19},{497/90,-19/30,0,7/3,7/3,7/3,235/247,227/90,-13/90,-1/2,-1/2,-1/2,175/972,5/4,3/19},{-8/5,221/162,-31/6,235/247,235/247,235/247,2251/200,2251/200,-18211/2240,235/247,235/247,235/247,-31/6,221/162,-8/5},{7/2,17/10,-392/81,227/90,227/90,227/90,2251/200,3902/225,-373/45,227/90,227/90,227/90,-392/81,17/10,7/2},{122/35,-17/20,5377/1215,-13/90,-13/90,-13/90,-18211/2240,-373/45,712/105,-13/90,-13/90,-13/90,5377/1215,-17/20,122/35},{3/19,5/4,175/972,-1/2,-1/2,-1/2,235/247,227/90,-13/90,7/3,7/3,7/3,0,-19/30,497/90},{3/19,5/4,175/972,-1/2,-1/2,-1/2,235/247,227/90,-13/90,7/3,7/3,7/3,0,-19/30,497/90},{3/19,5/4,175/972,-1/2,-1/2,-1/2,235/247,227/90,-13/90,7/3,7/3,7/3,0,-19/30,497/90},{746/243,-43/81,1437/500,175/972,175/972,175/972,-31/6,-392/81,5377/1215,0,0,0,3,-7/15,247/90},{413/180,-48/49,-43/81,5/4,5/4,5/4,221/162,17/10,-17/20,-19/30,-19/30,-19/30,-7/15,7/5,-13/10},{199/32,413/180,746/243,3/19,3/19,3/19,-8/5,7/2,122/35,497/90,497/90,497/90,247/90,-13/10,737/45}};

B1={{9,9,5,7,0,7/3,7/3,0,11/3,0,7/3,7/3,0,7/3,7/3,7/3,0,0,5/2},{9,9,5,7,0,7/3,7/3,0,11/3,0,7/3,7/3,0,7/3,7/3,7/3,0,0,5/2},{5,5,28,7/2,5,7,7,16/19,-21/2,16/19,7,7,16/19,7,7,7,2,4,13/3},{7,7,7/2,6349/200,14,7,7,8,11,373/90,7,7,373/90,7,7,7,22/9,2,23/2},{0,0,5,14,25,7/2,7/2,1066/81,7/2,3494/741,7/2,7/2,3494/741,7/2,7/2,7/2,85/27,7,0},{7/3,7/3,7,7,7/2,7,7,7/2,7,7/2,7,7,7/2,7,7,7,1,7/2,14/3},{7/3,7/3,7,7,7/2,7,7,7/2,7,7/2,7,7,7/2,7,7,7,1,7/2,14/3},{0,0,16/19,8,1066/81,7/2,7/2,21,10,8,7/2,7/2,8,7/2,7/2,7/2,18,3/2,-5/2},{11/3,11/3,-21/2,11,7/2,7,7,10,28,6,7,7,6,7,7,7,6,4,-1/2},{0,0,16/19,373/90,3494/741,7/2,7/2,8,6,5,7/2,7/2,5,7/2,7/2,7/2,11/2,-1/4,0},{7/3,7/3,7,7,7/2,7,7,7/2,7,7/2,7,7,7/2,7,7,7,1,7/2,14/3},{7/3,7/3,7,7,7/2,7,7,7/2,7,7/2,7,7,7/2,7,7,7,1,7/2,14/3},{0,0,16/19,373/90,3494/741,7/2,7/2,8,6,5,7/2,7/2,5,7/2,7/2,7/2,11/2,-1/4,0},{7/3,7/3,7,7,7/2,7,7,7/2,7,7/2,7,7,7/2,7,7,7,1,7/2,14/3},{7/3,7/3,7,7,7/2,7,7,7/2,7,7/2,7,7,7/2,7,7,7,1,7/2,14/3},{7/3,7/3,7,7,7/2,7,7,7/2,7,7/2,7,7,7/2,7,7,7,1,7/2,14/3},{0,0,2,22/9,85/27,1,1,18,6,11/2,1,1,11/2,1,1,1,7396/315,-11/3,-16/3},{0,0,4,2,7,7/2,7/2,3/2,4,-1/4,7/2,7/2,-1/4,7/2,7/2,7/2,-11/3,52/3,-5}};

B2={{5/2,5/2,13/3,23/2,0,14/3,14/3,-5/2,-1/2,0,14/3,14/3,0,14/3,14/3,14/3,-16/3,-5,28},{-77/90,-77/90,-7/6,9/5,1,-2,-2,1,-10/3,-2,-2,-2,-2,-2,-2,-2,1,7/2,14/3},{-77/90,-77/90,-7/6,9/5,1,-2,-2,1,-10/3,-2,-2,-2,-2,-2,-2,-2,1,7/2,14/3},{-77/90,-77/90,-7/6,9/5,1,-2,-2,1,-10/3,-2,-2,-2,-2,-2,-2,-2,1,7/2,14/3},{0,0,-1,-1,-13/4,-2,-2,1,-31/27,-2,-2,-2,-2,-2,-2,-2,11/2,-1/4,0},{-77/90,-77/90,-7/6,9/5,1,-2,-2,1,-10/3,-2,-2,-2,-2,-2,-2,-2,1,7/2,14/3},{-77/90,-77/90,-7/6,9/5,1,-2,-2,1,-10/3,-2,-2,-2,-2,-2,-2,-2,1,7/2,14/3},{0,0,-1,-1,-13/4,-2,-2,1,-31/27,-2,-2,-2,-2,-2,-2,-2,11/2,-1/4,0},{-28829/4480,-28829/4480,-55591/20007,-8,0,-10/3,-10/3,7/2,-757/81,-31/27,-10/3,-10/3,-31/27,-10/3,-10/3,-10/3,6,4,-1/2},{0,0,9/2,-229/81,-1327/972,1,1,109987/10080,7/2,1,1,1,1,1,1,1,18,3/2,-5/2},{-77/90,-77/90,-7/6,9/5,1,-2,-2,1,-10/3,-2,-2,-2,-2,-2,-2,-2,1,7/2,14/3},{-77/90,-77/90,-7/6,9/5,1,-2,-2,1,-10/3,-2,-2,-2,-2,-2,-2,-2,1,7/2,14/3},{0,0,99031/13440,-44/3,-1240243/162000,1,1,-1327/972,0,-13/4,1,1,-13/4,1,1,1,85/27,7,0},{-413/180,-413/180,1369/180,-195323/22050,-44/3,9/5,9/5,-229/81,-8,-1,9/5,9/5,-1,9/5,9/5,9/5,22/9,2,23/2},{1,1,6,1369/180,99031/13440,-7/6,-7/6,9/2,-55591/20007,-1,-7/6,-7/6,-1,-7/6,-7/6,-7/6,2,4,13/3},{-2246/315,-2246/315,1,-413/180,0,-77/90,-77/90,0,-28829/4480,0,-77/90,-77/90,0,-77/90,-77/90,-77/90,0,0,5/2},{-2246/315,-2246/315,1,-413/180,0,-77/90,-77/90,0,-28829/4480,0,-77/90,-77/90,0,-77/90,-77/90,-77/90,0,0,5/2}};

B3=Join[B1,B2];

(* the desired Gram matrices are A[14,6] and B[14,6], where the latter is constructed from B1 and B2 as follows *)

B[14,6]=Table[If[i>19&& j>19,B3[[36-i,36-j]],
If[i≤19, B3[[j,i]],
B3[[i,j]]]],{i,1,35},{j,1,35}];

(* check that A[14,6] and B[14,6] are positive semidefinite *)

Map[Sign,Expand[Det[A[14,6]-λ IdentityMatrix[15]]]]/.{Sign[λ]->λ}

Map[Sign,Expand[Det[B[14,6]-λ IdentityMatrix[35]]]]/.{Sign[λ]->λ}

(* the following are the corresponding word vectors needed in the sum of hermitian squares and commutators decompositions of S_{14,6}(x^2,y^2) *)

u[14,6]={y.y.y.x.x.x.x.x.x.y.y.x.x.y,y.x.x.y.y.x.x.y.y.x.x.x.x.y,y.y.y.x.x.x.x.y.y.x.x.x.x.y,y.x.x.y.y.y.y.x.x.x.x.x.x.y,y.y.y.x.x.y.y.x.x.x.x.x.x.y,y.y.y.y.y.x.x.x.x.x.x.x.x.y,y.x.x.x.x.y.y.y.y.x.x.x.x.y,y.x.x.y.y.x.x.x.x.y.y.x.x.y,y.y.y.x.x.x.x.x.x.x.x.y.y.y,y.x.x.x.x.x.x.x.x.y.y.y.y.y,y.x.x.x.x.x.x.y.y.x.x.y.y.y,y.x.x.x.x.x.x.y.y.y.y.x.x.y,y.x.x.x.x.y.y.x.x.x.x.y.y.y,y.x.x.x.x.y.y.x.x.y.y.x.x.y,y.x.x.y.y.x.x.x.x.x.x.y.y.y};

w[14,6]={y.y.x.x.y.y.x.x.x.x.x.x.y.y,y.y.y.y.x.x.x.x.x.x.x.x.y.y,y.y.x.x.x.x.x.x.y.y.y.y.x.x,y.y.x.x.x.x.y.y.x.x.y.y.x.x,x.x.y.y.y.y.x.x.x.x.y.y.x.x,y.y.x.x.y.y.x.x.x.x.y.y.x.x,y.y.y.y.x.x.x.x.x.x.y.y.x.x,x.x.y.y.x.x.y.y.y.y.x.x.x.x,y.y.x.x.x.x.y.y.y.y.x.x.x.x,x.x.y.y.y.y.x.x.y.y.x.x.x.x,y.y.x.x.y.y.x.x.y.y.x.x.x.x,y.y.y.y.x.x.x.x.y.y.x.x.x.x,x.x.y.y.y.y.y.y.x.x.x.x.x.x,y.y.x.x.y.y.y.y.x.x.x.x.x.x,y.y.y.y.x.x.y.y.x.x.x.x.x.x,y.y.y.y.y.y.x.x.x.x.x.x.x.x,x.x.x.x.y.y.y.y.y.y.x.x.x.x,x.x.y.y.x.x.y.y.x.x.y.y.x.x,y.y.x.x.x.x.y.y.x.x.x.x.y.y,x.x.x.x.x.x.x.x.y.y.y.y.y.y,x.x.x.x.x.x.y.y.x.x.y.y.y.y,x.x.x.x.x.x.y.y.y.y.x.x.y.y,x.x.x.x.x.x.y.y.y.y.y.y.x.x,x.x.x.x.y.y.x.x.x.x.y.y.y.y,x.x.x.x.y.y.x.x.y.y.x.x.y.y,x.x.x.x.y.y.x.x.y.y.y.y.x.x,x.x.x.x.y.y.y.y.x.x.x.x.y.y,x.x.x.x.y.y.y.y.x.x.y.y.x.x,x.x.y.y.x.x.x.x.x.x.y.y.y.y,x.x.y.y.x.x.x.x.y.y.x.x.y.y,x.x.y.y.x.x.x.x.y.y.y.y.x.x,x.x.y.y.x.x.y.y.x.x.x.x.y.y,x.x.y.y.y.y.x.x.x.x.x.x.y.y,y.y.x.x.x.x.x.x.x.x.y.y.y.y,y.y.x.x.x.x.x.x.y.y.x.x.y.y};

difference=matMult[A[14,6],u[14,6]]+matMult[B[14,6],w[14,6]]-S[14,6]

(* cycEqNF produces a normal form with respect to cyclic equivalence *)

cycEqNF[x_]:=x/;Head[x]=!=Dot&&Head[x]=!=Times&&Head[x]=!=Plus
cycEqNF[w_Dot]:=First[Sort[Table[RotateLeft[w,i],{i,0,Length[w]-1}]]]
cycEqNF[m_Times]:=Map[cycEqNF,m]
cycEqNF[f_Plus]:=Map[cycEqNF,f]

(* S_{14,6}(x^2,y^2) is a sum of hermitian squares and commutators if difference=0 *)

cycEqNF[difference]