Int[K_,col_]:=K/.{
Pos[a_,b_,c_,d_]:>  
 H[{a,b},-1]+H[{a,c},-Colour[a,col]+1]+H[{a,d},Colour[b,col]]+H[{b,c},-1]+H[{c,d},-Colour[b,col]],

Neg[a_,b_,c_,d_]:> 
 H[{a,b},-Colour[b,col]]+H[{a,d},Colour[b,col]]+H[{b,c},-1]+H[{b,d},1-Colour[a,col]]+H[{c,d},-1],

P[a_,b_]-> H[{a},1]+H[{b},-1],
 

CD[a_,c_,b_,d_]:> H[{a,b},(1/2)*(Colour[a,col]+Colour[b,col])]+H[{a,c},-Colour[b,col]]+H[{a,d},(1/2)*(Colour[a,col]-Colour[b,col])]+H[{b,c},(1/2)*(Colour[a,col]-Colour[b,col])]+H[{b,d},Colour[a,col]]+H[{c,d},(1/2)*(-Colour[a,col]-Colour[b,col])],

Arr[a_,b_,c_,d_]:> H[{b,c},-Colour[a,col]]+H[{b,d},Colour[a,col]]+H[{c,d},-Colour[b,col]],

HBlob[a_,b_]:> H[{a},Colour[a,col]]+H[{b},-Colour[a,col]] }



H/:H[l_List,a__]**H[k_List,b__]:=H[Sort[Join[l,k]],Signature[Ordering[Join[l,k]]]*a*b]
H/:  H[l_List,a_]+H[l_,b_]:=H[l,a+b]
H/:k_*H[l_List,a__]:=H[l,k*a]
H[l_List,a_]/;  Length[Union[l]]<Length[l] := 0
H/: 0**H[k_List,b__]:=0
H/: H[k_List,b__]**0:=0
H/: H[l_List,0]:=0



Colour[i_,col_]:=t[Position[col,i][[1,1]]]

Prod[{a_}]:=a
Prod[l_List]:=l[[1]]**Prod[Drop[l,1]]


Proj[L_,n_]:=L/.H[l_List,a_]/; Take[l,n]!=Range[n]->  0/.H[l_List,a_]:>  H[Drop[l,n],a]

Sig[K_,n_,m_]:=Signature[Ordering[Select[List@@Join@@Apply[ List, K, {1}],m>=#>n&]]]

AT[K_,n_,m_,col_]:=Proj[Sig[K,n,m]*Distribute[Prod[Int[K,col]]],n]/. H[l_List,a_]:>H[l,Expand[a]]

"Test for Chord Diagrams - Relation"

K[1]={CD[4,2,3,1],CD[2,5,1,6]}

K[2]={CD[2,5,3,1],CD[4,2,1,6]}
K[3]={P[3,1],P[4,2],P[2,5],P[1,6]}

AT[K[1],2,4,{{2,4,5},{1,3,6}}]-AT[K[2],2,4,{{2,4,5},{1,3,6}}]===Expand[(t[1]*t[2])*AT[K[3],2,4,{{2,4,5},{1,3,6}}]]