(* ::Package:: *)

(************************************************************************)
(* This file was generated automatically by the Mathematica front end.  *)
(* It contains Initialization cells from a Notebook file, which         *)
(* typically will have the same name as this file except ending in      *)
(* ".nb" instead of ".m".                                               *)
(*                                                                      *)
(* This file is intended to be loaded into the Mathematica kernel using *)
(* the package loading commands Get or Needs.  Doing so is equivalent   *)
(* to using the Evaluate Initialization Cells menu command in the front *)
(* end.                                                                 *)
(*                                                                      *)
(* DO NOT EDIT THIS FILE.  This entire file is regenerated              *)
(* automatically each time the parent Notebook file is saved in the     *)
(* Mathematica front end.  Any changes you make to this file will be    *)
(* overwritten.                                                         *)
(************************************************************************)



AllWords[n_,d_]:=AW@@@Tuples[Union@@Table[{Subscript[x, i],Subscript[y, i]}, {i,n}], d]


AllRelators2[n_]:=Flatten[{
Table[{Subscript[cx, i,j],Subscript[cy, i,j],Subscript[cxy, i,j]}, {i,1,n-1},{j,i+1,n}],
Table[Subscript[c, n,i],{i,n}]
}];
AllRelators3[n_] := Flatten[Table[
{Subscript[ctx, i,j,k],Subscript[cty, i,j,k],Subscript[ctx, j,k,i],Subscript[cty, j,k,i],Subscript[ctx, k,i,j],Subscript[cty, k,i,j]},
{i,1,n-2},{j,i+1,n-1},{k,j+1,n}
]];


AllRelators2[n_,d_] := Flatten[Table[
Outer[Join,AllWords[n,k], AW /@ AllRelators2[n], AllWords[n,d-k-2]],
{k,0,d-2}
]];
AllRelators3[n_,d_] := Flatten[Table[
Outer[Join,AllWords[n,k], AW /@ AllRelators3[n], AllWords[n,d-k-3]],
{k,0,d-3}
]];
AllRelators[n_,d_] := Join[AllRelators2[n,d], AllRelators3[n,d]];


b[x_,y_] := AW[x,y]-AW[y,x];
b[x_,y_,z_] := AW[x,y,z]-AW[y,x,z]-AW[z,x,y]+AW[z,y,x];
diff[Subscript[x, i_]]:=Subscript[x, i]; diff[Subscript[y, i_]]:=Subscript[y, i];
diff[Subscript[cx, i_,j_]]:=b[Subscript[x, i],Subscript[x, j]];
diff[Subscript[cy, i_,j_]]:=b[Subscript[y, i],Subscript[y, j]];
diff[Subscript[cxy, i_,j_]]:=b[Subscript[x, i],Subscript[y, j]]-b[Subscript[x, j],Subscript[y, i]];
diff[Subscript[ctx, i_,j_,k_]] := b[Subscript[x, i],Subscript[y, j],Subscript[x, k]];
diff[Subscript[cty, i_,j_,k_]] := b[Subscript[x, i],Subscript[y, j],Subscript[y, k]];
diff[Subscript[c, n_,i_]] := \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(j = 1\), \(n\)]\(b[
\*SubscriptBox[\(x\), \(i\)], 
\*SubscriptBox[\(y\), \(j\)]]\)\);


diff[aw_AW] := Distribute[diff /@ aw] /. AW[lft___, c_.*AW[w___],rgt___] :> c*AW[lft,w,rgt]


Dim[n_,d_] := Module[{im,v,vc},
im=(diff/@AllRelators[n,d]) /. Thread[AllWords[n,d] -> Table[v[i], {i,(2n)^d}]];
If[im=={},
(2n)^d,
(2n)^d-MatrixRank[
SparseArray[
Flatten[Table[
(*Cases[{im\[LeftDoubleBracket]i\[RightDoubleBracket]}, c_.*v[j_] \[RuleDelayed]  ({i,j}\[Rule]c),\[Infinity]],{i,Length[im]}]
Wrong! c_.*v[j_] matches some terms twice, producing extra matrix entries. *)
vc=im[[i]];
({i,#[[1]]} ->  Coefficient[vc, #])& /@ Cases[{vc}, _v, \[Infinity]],
{i, Length@im}
]],
{Length[im], (2n)^d}]
]
]
]



