Pensieve header: Implementing KH, day 3.

Import["http://www.math.toronto.edu/~drorbn/papers/Categorification/QRG.pdf"]

Road map:
1. Produce all the info in a “cube of smoothings”.
2. Produce a commuting cube of vector spaces and maps between them.
3. Produce a complex.
4. Compute homology.

K[3,1]=Xm[1,4,2,5] Xm[3,6,4,1] Xm[5,2,6,3];
K[5,1]=Xm[1,6,2,7] Xm[3,8,4,9] Xm[5,10,6,1] Xm[7,2,8,3] Xm[9,4,10,5];
K[10,132]=Xm[5,12,6,13] Xm[9,16,10,17] Xm[11,6,12,7] Xm[13,20,14,1] Xm[15,18,16,19] Xm[17,10,18,11] Xm[19,14,20,15] Xp[2,8,3,7] Xp[4,2,5,1] Xp[8,4,9,3];

SetAttributes[p,Orderless];
SetAttributes[dx,Orderless];
α=0;
ϵ /: (ϵ^(n_))/; n>1 =0;
t1=Expand[
dx[]K[10,132] /. {
(Xp|Xm)[i_,j_,k_,l_] :> (++α; 
p[i,j]p[k,l]+dx[α]p[i,l]p[j,k]+ϵ e[α]X[i,j,k,l])
} /. p[i_,j_] :> p[i,j][Min[i,j]]
] //. p[i_,j_][m_]p[j_,k_][n_] :> p[i,k][Min[m,n]] /. {
X[i_,j_,k_,l_]p[i_,j_][m_]p[k_,l_][n_] :>  (c[m]c[n]->c[Min[m,n]]),
X[i_,j_,k_,l_]p[i_,l_][m_]p[j_,k_][n_] :> (c[Min[m,n]]->c[m]c[n])
}/. 
((p[i_,j_][m_])^(_.)):>c[m] //. dx[i___]dx[j___]:> dx[i,j]

SetAttributes[{p,dx},Orderless];
S[K_] := Module[{α=0,ϵ,X,Z},
ϵ /: (ϵ^(_)) =0;
Z=Expand[
dx[]K/. {
(Xp|Xm)[i_,j_,k_,l_] :> (++α; 
p[i,j]p[k,l]+dx[α]p[i,l]p[j,k]+ϵ e[α]X[i,j,k,l])
} /. p[i_,j_] :> p[i,j][Min[i,j]]
] //. p[i_,j_][m_]p[j_,k_][n_] :> p[i,k][Min[m,n]] /. {
X[i_,j_,k_,l_]p[i_,j_][m_]p[k_,l_][n_] :>  (c[m]c[n]->c[Min[m,n]]),
X[i_,j_,k_,l_]p[i_,l_][m_]p[j_,k_][n_] :> (c[Min[m,n]]->c[m]c[n])
}/. 
((p[i_,j_][m_])^(_.)):>c[m] //. dx[i___]dx[j___]:> dx[i,j];
CoefficientList[Z,ϵ,{2}]
]

CoefficientList[(((1+x))^7),x, {4}]

S[K[3,1]] // Column

({S0,S1}=S[K[10,132]]) //Timing

({S0,S1}=S[K[3,1]]) //Timing

V0=List@@Expand[S0 /. c[i_] :> vp[i]+vm[i]]

Length@V0

dx[3] e[2] (c[1] c[2]->c[1])

Clear[d]

d[dx[αs___]e[β_]cs_.(c[i_]c[j_]->c[k_])] := {
dx[αs]vp[i]vp[j]->dx[αs,β]vp[k],
dx[αs]vm[i]vp[j]->dx[αs,β]vm[k],
dx[αs]vp[i]vm[j]->dx[αs,β]vm[k],
dx[αs]vm[i]vm[j]->0,
dx[βs___] /; {βs}=!={αs} :> 0
}

V0 /. d[dx[3] e[2] (c[1] c[2]->c[1])]