Pensieve header: Infinitemial Elliptic computations, version Associative.

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_])] := (∑_(j=1)^n)b[(Subscript[x, i]),(Subscript[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[[i]]}, c_.*v[j_] :>  ({i,j}->c),∞],{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, ∞],
{i, Length@im}
]],
{Length[im], (((2n))^d)}]
]
]
]

Table[Dim[2,d], {d, 6}] // Timing

Testing

AllWords[4,0]

AllWords[2,3] // Length

AllRelators2[3]

AllRelators3[4]

{AllRelators2[3,3], AllRelators3[3,3]}

{diff[(Subscript[cx, 2,4])],diff[(Subscript[cxy, 2,4])],diff[(Subscript[cty, 1,2,3])],diff[(Subscript[c, 3,2])]}

diff[AW[(Subscript[cx, 1,2]),(Subscript[x, 3])]]

diff /@ AllRelators[3,3]

{n,d}={3,3}

Dim[3,3]

Dim[1,1]

Dim[1,2]

Dim[1,3]

Dim[1,5]

Dim[2,1]

Dim[2,2]

Dim[2,3]

Dim[2,4]

Dim[2,5]

Dim[2,6]

Dim[3,1]

Dim[3,2]

Dim[3,3]

Dim[3,4]