Pensieve header: RVK and Z. Continues pensieve://Projects/SL2Portfolio2/.

RVK and Z

RVK, rot, Z from 2016-09/OneSmidgen.nb. See also in AP/Projects/SL2Invariant/.

Some details of the code below are at http://drorbn.net/bbs/show?shot=Dror-160920-151350.jpg.

RVK::usage="RVK[xs, rots] represents a Rotational Virtual Knot with a list of n Xp/Xm crossings xs and a length 2n list of rotation numbers rots. Crossing sites are indexed 1 through 2n, and rots[[k]] is the rotation between site k-1 and site k. RVK is also a casting operator converting to the RVK presentation from other knot presentations.";

RVK[pd_PD]:=(Subscript[PP, RVK])@Module[{n,xs,x,rots,front={0},k},
n=Length@pd;rots=Table[0,{2n}];
xs=Cases[pd,x_X:>(Piecewise[{{Xp[x[[4]],x[[1]]], PositiveQ@x}, {Xm[x[[2]],x[[1]]], True}}])];
For[k=0,k<2n,++k,If[k==0∨FreeQ[front,-k],
front=Flatten@Replace[front,k->(xs/.{
Xp[k+1,l_]|Xm[l_,k+1]:>{l,k+1,1-l},
Xp[l_,k+1]|Xm[k+1,l_]:>(++rots[[l]];{1-l,k+1,l}),
_Xp|_Xm:>{}
}), {1}],
Cases[front,k|-k]/.{k,-k}:>--rots[[k+1]];
]];
RVK[xs,rots] ];
RVK[K_]:=RVK[PD[K]];

rot[i_,0]:=(Subscript[dη, i]);
rot[i_,n_]:=Module[{j},
rot[i,n]=If[n>0,rot[i,n-1](Subscript[kC, j]),rot[i,n+1](Subscript[(OverBar[kC]), j])]//(Subscript[km, i,j->i])];

Z[K_] := Z[RVK@K];
Z[rvk_RVK] := Monitor[ (Subscript[PP, "Z"])@Module[{todo,rots,ζ,done,st,cx, ζ1, i,j,k},
{todo,rots}=List@@rvk;
ζ=(Subscript[dη, 0]);
done={0};
st=Range[0,2Length[todo]+1];
While[{}=!=($M=todo),
cx=RandomChoice@MaximalBy[todo, Length[done⋂{#[[1]], #[[2]], #[[1]]-1,#[[2]]-1}]&];
{i,j}=List@@cx;
ζ1=(cx/.{_Xp:>(Subscript[kR, i,j])(Subscript[(OverBar[kKink]), 0]),_Xm:>(Subscript[(OverBar[kR]), i,j])(Subscript[kKink, 0])})//(Subscript[km, j,0->j]);
Do[ζ1=(rot[0,rots[[k]]]ζ1)//(Subscript[km, 0,k->k]), {k,{i,j}}];
ζ*=ζ1;
Do[If[MemberQ[done, k], ζ=ζ//(Subscript[km, st[[k+1]],k+1->st[[k+1]]]); st=st/.st[[k+2]]->st[[k+1]]],
{k,{i,i-1,j,j-1}}];
done=done⋃{i-1,i,j-1,j};
todo=DeleteCases[todo, cx]
];
CF/@ (ζ /. {(Subscript[x, 0])->x,(Subscript[y, 0])->y,(Subscript[a, 0])->a})
], $M]