Pensieve header: Computing $H^4$ of the Drinfel’d-Kohno cohomology, which rules the degree by degree extension of horizontal associators.

SetDirectory["C:\\drorbn\\AcademicPensieve\\People\\Kuno"];
<< FreeLie.m

Basis[n_,m_]:=Union@@Table[DK[j,#]&/@AllLyndonWords[m,Range[j-1]],{j,2,n}]

Basis[4,3]

(Subscript[d, n_])[ℰ_]:=Expand[ℰ/.dk_DK:>Plus[
(dk^(σ@@Range[2,n+1])),
Sum[(((-1))^i)(dk^(Join[σ@@Range[i-1],σ[{i,i+1}],σ@@Range[i+2,n+1]])),{i,n}],
(((-1))^(n+1))dk
]]

Basis[3,2]//(Subscript[d, 3])

Basis[4,2]//(Subscript[d, 4])

r[n_,m_]:=r[n,m]=Module[{dk,B0,B1,b0,b1,db0,mat},
B0=Basis[n,m];
If[B0=={},Return[0]];
B1=Basis[n+1,m]/.DK->dk;
mat=Table[
db0=(Subscript[d, n])[b0]/.DK->dk/.dk[k_,x_Plus]:>(dk[k,#]&/@x)/.dk[k_,c_?NumberQ*x_]:>c*dk[k,x];
Table[Coefficient[db0,b1],{b1,B1}],
{b0,B0}
];
MatrixRank[mat]
]

r[4,2]

r[3,2]

Betti[n_,m_]:=Length[Basis[n,m]]-r[n-1,m]-r[n,m]

Betti[4,2]

Betti[4,3]

Betti[4,4]

Betti[4,5]

Betti[4,6]

AbsoluteTiming@Table[Echo@Betti[3,m],{m,10}]

Table[Echo@Betti[3,m],{m,10}]

AbsoluteTiming[Betti[3,11]]

Table[Betti[3,m],{m,11}]

Table[Echo@Betti[4,m],{m,8}]

Table[Echo@Betti[4,m],{m,9}]