Pensieve header: An attempt on a concise implementation of the FastKh algorithm.

<< KnotTheory`

EC[λ_List] := Module[{ρ, ec, p},
ec=Fold[
(ρ = First /@ Position[#1, #2];
Append[Delete[#1, List /@ ρ], Union@@(#1[[ρ]])])&,
λ, Union @@ λ
] // SortBy[#, First]&;
p=Union@@Replace[ec, c_ :> ((# -> First[c])& /@ c), {1}];
{ec, First/@ec, p}
];

dot /: ((dot[_])^(k_)) := 0;
EC[λ__S] := EC[Join@@List@@@{λ}];(σ_S)[i_] := Cases[σ, {i,j_}|{j_,i} :> j][[1]]

VCLaw[β_S, μ_S, τ_S] := Module[
{$,comps,p, ins1, ins2, outs, χs, χ, h, law1={}, law2={}, dec} ,
{$,comps,p}  = EC[β,μ,τ];
ins1=EC[β,μ][[2]]; ins2=EC[μ,τ][[2]]; outs=EC[β,τ][[2]];
χs = ((Times @@ (h/@ Join[ins1, ins2, outs] /. p))/( PowerExpand[(((Times @@ (h /@ (Last /@ p))))^(1/2))]));
dec = χs /. ((h[i_])^(χ_.)) :> (((2dot[i]))^((2-χ)/2));
dec *= Times @@ MapThread[If[#1==#2, 1, dot[#1]+dot[#2]]&,
{outs, outs/.p}];
law1=dot/@ins1; law1=Thread[law1->(law1/.p)];
law2=dot/@ins2; law2=Thread[law2->(law2/.p)];
{law1, law2, Expand[dec]}
];
VC[Cob[β_S, μ_S, dots1_], Cob[μ_S, τ_S, dots2_]] := Module[
{law1, law2, dec},
{law1, law2, dec} = VCLaw[β,μ,τ];
Cob[β, τ, Expand[dec*(dots1/.law1)(dots2/.law2)]]
];