SetDirectory["/home/travis/documents/workbook/mathematica/braidors"];
<< ../WKOIV/FreeLie.m;
$SeriesShowDegree=2;
Arb=Arbitrator -> (Replace[#, _->RandomInteger[{-100,100}], 1]&);
Deg4=6;
DegLie2=12;

AngleBracket /: λ1_AngleBracket ** λ2_AngleBracket /; Support[λ1]==Support[λ2] := (Subscript[BCH, tb])[λ1, λ2];
AngleBracket /: λ1_AngleBracket ** λ2_AngleBracket := NonCommutativeMultiply[
λ1⋃((#->LS[0])& /@ ⟨Complement[Support@λ2, Support@λ1]⟩),
λ2⋃((#->LS[0])& /@ ⟨Complement[Support@λ1, Support@λ2]⟩)
];
AngleBracket /: λ1_AngleBracket + λ2_AngleBracket /; Support[λ1]==Support[λ2] :=⟨Table[
u -> Total[(Subscript[#, u])& /@ {λ1,λ2}],
{u, Union@@(Support[#]& /@ {λ1,λ2})}
]⟩;
AngleBracket /: λ1_AngleBracket + λ2_AngleBracket :=(λ1⋃((#->LS[0])& /@ ⟨Complement[Support@λ2, Support@λ1]⟩)) +
(λ2⋃((#->LS[0])& /@ ⟨Complement[Support@λ1, Support@λ2]⟩))
tσ[us_List -> vs_List][ser_LieSeries|ser_CWSeries|ser_AngleBracket] := ser // LieMorphism[Thread[(LW/@us)->(LW/@vs)]];
tσ[u_, v_] := tσ[{u}->{v}];
tσ[us_List -> vs_List][ζ_Es] := tσ[us->vs] /@ ζ;
hσ[xs_List -> ys_List][λ_AngleBracket] := Union[λ∖xs, ⟨Thread[ys-> Table[(Subscript[λ, x]),{x, xs}]]⟩];
hσ[x_, y_] := hσ[{x}->{y}];
dσ[as_List -> bs_List][ζ_] := ζ // tσ[as->bs] // hσ[as->bs];
dσ[a_, b_][ζ_] := ζ // tσ[a,b] // hσ[a,b];
λ_AngleBracket // dΔ[a_,b_,c_] :=(λ∖a)⋃⟨b->(Subscript[λ, a]),c->(Subscript[λ, a])⟩//LieMorphism[LW@a->LW@b+LW@c];
ξ_AngleBracket // σ[s___List] := Module[{ξ1},
ξ1 = ξ // dσ[Range[Length@{s}] -> First /@ {s}];
Do[
ξ1 = ξ1 // dΔ[{s}[[i,1]], {s}[[i,1]], {s}[[i,j]]],
{i,Length@{s}}, {j,2,Length@{s}[[i]]}
];
ξ1
];
AngleBracket /: (((ξ_AngleBracket))^(s_σ)):=ξ//s;
dimTDer[n_Integer,r_Integer]:=n((1/r)Sum[ MoebiusMu[d] (((n))^(r/d)),{d,Select[Table[i,{i,1,r}],Divisible[r,#]&]}])-n;
x=LW@"x";y=LW@"y";z=LW@"z";

Check its a differential

$SeriesShowDegree=9;

α=LS[{1,2},α1s];β=LS[{1,2},β1s];
F=⟨1->α, 2->β⟩;

dF=(F^(σ[12,3]))+(F^(σ[1,2]))-(F^(σ[1,3]))-(F^(σ[13,2]));

ddF=(dF^(σ[12,3,4]))-(dF^(σ[1,3,4]))-(dF^(σ[13,2,4]))+(dF^(σ[1,2,4]))+(dF^(σ[14,2,3]))-(dF^(σ[1,2,3]))

$SeriesShowDegree=2;

Cohomology in tder

α1=LS[{1,2},α1s];β1=LS[{1,2},β1s];
a1=⟨1->α1, 2->β1⟩;

μ1=LS[{1,2,3},μ1s];ν1=LS[{1,2,3},ν1s];η1=LS[{1,2,3},η1s];
b1=⟨1->μ1, 2->ν1,3->η1⟩;

ϕ1=LS[{1,2},ϕ1s];ψ1=LS[{1,2},ψ1s];
c1=⟨1->ϕ1, 2->ψ1⟩;

TDer=SeriesSolve[{ϕ1,ψ1},CWS[0]≡CWS[0],Arb];

Z2TDer=SeriesSolve[{α1,β1},(a1^(σ[12,3]))+(a1^(σ[1,2]))≡(a1^(σ[1,3]))+(a1^(σ[13,2])),Arb];

Z3TDer=SeriesSolve[{μ1,ν1,η1}, ((b1^(σ[12,3,4]))+(b1^(σ[1,2,4]))+(b1^(σ[14,2,3]))≡(b1^(σ[1,3,4]))+(b1^(σ[13,2,4]))+(b1^(σ[1,2,3]))),Arb];

a1@{Deg4};//Timing

b1@{Deg4};//Timing

c1@{Deg4};//Timing

ArbTDer=Length[Last[#]]-2 & /@ Read[TDer]

ArbTDerExact=Table[dimTDer[2,i],{i,1,Deg4}]

ArbZ2TDer=Length[Last[#]] & /@ Read[Z2TDer]

ArbZ3TDer=Length[Last[#]] & /@ Read[Z3TDer]

DimH3SDer=ArbZ2TDer+ArbZ3TDer-ArbTDer

DimH3SDerExact=ArbZ2TDer+ArbZ3TDer-ArbTDerExact

Cohomology in sder

α2=LS[{1,2},α2s];β2=LS[{1,2},β2s];
a2=⟨1->α2, 2->β2⟩;

μ2=LS[{1,2,3},μ2s];ν2=LS[{1,2,3},ν2s];η2=LS[{1,2,3},η2s];
b2=⟨1->μ2, 2->ν2,3->η2⟩;

ϕ2=LS[{1,2},ϕ2s];ψ2=LS[{1,2},ψ2s];
c2=⟨1->ϕ2, 2->ψ2⟩;

SDer=SeriesSolve[{ϕ2,ψ2},(ℏ^(-1))(b[LW@1,ϕ2]+b[LW@2,ψ2] ≡ LS[0])];

Z2SDer=SeriesSolve[{α2,β2},(ℏ^(-1))(b[LW@1,α2]+b[LW@2,β2] ≡ LS[0])∧((a2^(σ[12,3]))+(a2^(σ[1,2]))≡(a2^(σ[1,3]))+(a2^(σ[13,2]))),Arb];

Z3SDer=SeriesSolve[{μ2,ν2,η2}, (ℏ^(-1))(b[LW@1,μ2]+b[LW@2,ν2] +b[LW@3,η2]≡ LS[0])∧((b2^(σ[12,3,4]))+(b2^(σ[1,2,4]))+(b2^(σ[14,2,3]))≡(b2^(σ[1,3,4]))+(b2^(σ[13,2,4]))+(b2^(σ[1,2,3]))),Arb];

a2@{Deg4} ; //Timing

b2@{Deg4};//Timing

c2@{Deg4};//Timing

ArbSDer=Length[Last[#]] & /@ Read[SDer]

ArbSDerExact=Table[dimTDer[2,i],{i,1,Deg4}]

ArbZ2SDer=Length[Last[#]] & /@ Read[Z2SDer]

ArbZ3SDer=Length[Last[#]] & /@ Read[Z3SDer]

Cohomology in kv

α3=LS[{1,2},α3s];β3=LS[{1,2},β3s];
a3=⟨1->α3, 2->β3⟩;

μ3=LS[{1,2,3},μ3s];ν3=LS[{1,2,3},ν3s];η3=LS[{1,2,3},η3s];
b3=⟨1->μ3, 2->ν3,3->η3⟩;

ϕ3=LS[{1,2},ϕ3s];ψ3=LS[{1,2},ψ3s];
c3=⟨1->ϕ3, 2->ψ3⟩;

KV=SeriesSolve[{ϕ3,ψ3},(ℏ^(-1))(b[LW@1,ϕ3]+b[LW@2,ψ3] ≡ LS[0])∧(div[c3]≡CWS[0]),Arb];

Z2KV=SeriesSolve[{α3,β3},(ℏ^(-1))(b[LW@1,α3]+b[LW@2,β3] ≡ LS[0])∧(div[a3]≡CWS[0])∧((a3^(σ[12,3]))+(a3^(σ[1,2]))≡(a3^(σ[1,3]))+(a3^(σ[13,2]))),Arb];

Z3KV=SeriesSolve[{μ3,ν3,η3}, (ℏ^(-1))(b[LW@1,μ3]+b[LW@2,ν3] +b[LW@3,η3]≡ LS[0])∧(div[b3]≡CWS[0])∧((b3^(σ[12,3,4]))+(b3^(σ[1,2,4]))+(b3^(σ[14,2,3]))≡(b3^(σ[1,3,4]))+(b3^(σ[13,2,4]))+(b3^(σ[1,2,3])))∧(div[b3]≡CWS[0]),Arb];

a3@{Deg4};//Timing

b3@{Deg4};//Timing

c3@{Deg4};//Timing

ArbKV=Length[Last[#]] & /@ Read[KV]

ArbZ2KV=Length[Last[#]] & /@ Read[Z2KV]

ArbZ3KV=Length[Last[#]] & /@ Read[Z3KV]

DimH3KV=ArbZ2KV+ArbZ3KV-ArbKV

Cohomology in kv^

α4=LS[{1,2},α4s];β4=LS[{1,2},β4s];
a4=⟨1->α4, 2->β4⟩;

μ4=LS[{1,2,3},μ4s];ν4=LS[{1,2,3},ν4s];η4=LS[{1,2,3},η4s];
b4=⟨1->μ4, 2->ν4,3->η4⟩;

ϕ4=LS[{1,2},ϕ4s];ψ4=LS[{1,2},ψ4s];
c4=⟨1->ϕ4, 2->ψ4⟩;

KVH=SeriesSolve[{ϕ4,ψ4},(ℏ^(-1))(b[LW@1,ϕ4]+b[LW@2,ψ4] ≡ LS[0])∧(Plus[
	(div[c4])//LieMorphism[{LW@1->y,LW@2->z}],
	-((div[c4])//LieMorphism[{LW@1->x+y,LW@2->z}]),
	(div[c4])//LieMorphism[{LW@1->x,LW@2->y+z}],
	-((div[c4])//LieMorphism[{LW@1->x,LW@2->y}])
	]≡CWS[0]) ,Arb];

Z2KVH=SeriesSolve[{α4,β4},(ℏ^(-1))(b[LW@1,α4]+b[LW@2,β4] ≡ LS[0])∧((a4^(σ[12,3]))+(a4^(σ[1,2]))≡(a4^(σ[1,3]))+(a4^(σ[13,2])))∧(Plus[
	(div[a4])//LieMorphism[{LW@1->y,LW@2->z}],
	-((div[a4])//LieMorphism[{LW@1->x+y,LW@2->z}]),
	(div[a4])//LieMorphism[{LW@1->x,LW@2->y+z}],
	-((div[a4])//LieMorphism[{LW@1->x,LW@2->y}])
	]≡CWS[0]),Arb];

Z3KVH=SeriesSolve[{μ4,ν4,η4}, (ℏ^(-1))(b[LW@1,μ4]+b[LW@2,ν4] +b[LW@3,η4]≡ LS[0])∧(div[b4]≡CWS[0])∧((b4^(σ[12,3,4]))+(b4^(σ[1,2,4]))+(b4^(σ[14,2,3]))≡(b4^(σ[1,3,4]))+(b4^(σ[13,2,4]))+(b4^(σ[1,2,3])))∧(div[b4]≡CWS[0]),Arb];

a4@{Deg4};//Timing

b4@{Deg4};//Timing

c4@{Deg4};//Timing

ArbKVH=Length[Last[#]] & /@ Read[KVH]

ArbZ2KVH=Length[Last[#]] & /@ Read[Z2KVH]

ArbZ3KVH=Length[Last[#]] & /@ Read[Z3KVH]

DimH3KVH=ArbZ2KVH+ArbZ3KVH-ArbKVH