<< KnotTheory`

(*WP:Wedge Product*)WSort[expr_]:=Expand[expr/.w_W:>Signature[w]*Sort[w]];
WP[0,_]=WP[_,0]=0;
WP[a_,b_]:=WSort[Distribute[a**b]/.(c1_.*w1_W)**(c2_.*w2_W):>c1 c2 Join[w1,w2]];

(*IM:Interior Multiplication*)
IM[{},expr_]:=expr;
IM[i_,w_W]:=If[FreeQ[w,i],0,-(-1)^Position[w,i][[1,1]]*DeleteCases[w,i]];
IM[{is___,i_},w_W]:=IM[{is},IM[i,w]];
IM[is_List,expr_]:=expr/.w_W:>IM[is,w]

(*pA on Crossings*)
pA[Xp[i_,j_,k_,l_]]:=AHD[(t[i]==t[k])(t[j]==t[l]),{i,l},W[j,k],W[l,i]+(t[i]-1)W[l,j]-t[l]W[l,k]+W[i,j]+t[l]W[j,k]];
pA[Xm[i_,j_,k_,l_]]:=AHD[(t[i]==t[k])(t[j]==t[l]),{i,j},W[k,l],t[j]W[i,j]-t[j]W[i,l]+W[j,k]+(t[i]-1)W[j,l]+W[k,l]]

(*Variable Equivalences*)
ReductionRules[Times[]]={};
ReductionRules[Equal[a_,b__]]:=(#->a)&/@{b};
ReductionRules[eqs_Times]:=Join@@(ReductionRules/@List@@eqs)

(*AHD:Alexander Half Densities*)
AHD[eqs_,is_,-os_,p_]:=AHD[eqs,is,os,Expand[-p]];
AHD/:Reduce[AHD[eqs_,is_,os_,p_]]:=AHD[eqs,Sort[is],WSort[os],WSort[p/.ReductionRules[eqs]]];
AHD/:AHD[eqs1_,is1_,os1_,p1_] AHD[eqs2_,is2_,os2_,p2_]:=Module[{glued=Intersection[Union[is1,is2],List@@Union[os1,os2]]},Reduce[AHD[eqs1*eqs2//.eq1_Equal*eq2_Equal/;Intersection[List@@eq1,List@@eq2]=!={}:>Union[eq1,eq2],Complement[Union[is1,is2],glued],IM[glued,WP[os1,os2]],IM[glued,WP[p1,p2]]]]]

(*pA on Circuit Diagrams*)
pA[cd_CircuitDiagram,eqs___]:=pA[cd,{},AHD[Times[eqs],{},W[],W[]]];
pA[cd_CircuitDiagram,done_,ahd_AHD]:=Module[{pos=First[Ordering[Length[Complement[List@@#,done]]&/@cd]]},pA[Delete[cd,pos],Union[done,List@@cd[[pos]]],ahd*pA[cd[[pos]]]]];
pA[CircuitDiagram[],_,ahd_AHD]:=ahd

pd=Delete[PD[Knot[10,100]],5]

cd=CircuitDiagram@@pd /. {x_X?PositiveQ :> Xp@@x, x_X?NegativeQ :> Xm@@x}

cd // pA

IEM[W[],expr_]:=expr;   (*Interior-Exterior Multiplication*)
IEM[W[i_, is___],expr_]:=IEM[W[is],IM[{i},expr]+WP[W[i],expr]];

IEM[W[3,11], W[3,10]]

IEM[W[3,10], W[3,10]]

IEM[W[1,2,3], W[1,2,3]]

IEM[W[1,2,3,4], W[1,2,3,4]]

Signature[Reverse[Range[#]]]& /@ Range[10]

HS[AHD[eqs_,is_,os_,p_]] := AEDF[eqs, is, os, p /. w_W :> IEM[w, os]]

cd // pA // HS

??PositiveQ