Pensieve header:  A fresh implementation of baby DoPeGDO, the Knot Theory part.

Some Knot Theory

Define[(Subscript[Kink, i])=(Subscript[CC, 3])(Subscript[R, 1,2])//(Subscript[m, 2,3->2])//(Subscript[m, 2,1->i]), (Subscript[(OverBar[Kink]), i])=(Subscript[CC, 3])(Subscript[(OverBar[R]), 1,2])//(Subscript[m, 1,3->1])//(Subscript[m, 1,2->i])]

RVK[pd_PD]:=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[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})
})],
Cases[front,k|-k]/.{k,-k}:>--rots[[k+1]];
]];
RVK[xs,rots] ];
RVK[K_]:=RVK[PD[K]];

rot[i_,0]:=(Subscript[𝔼, {}->{i}])[1,0,ϵSeries@0];
rot[i_,n_]:=Module[{j},
rot[i,n]=If[n>0,rot[i,n-1](Subscript[CC, j]),rot[i,n+1](Subscript[(OverBar[CC]), j])]//(Subscript[m, i,j->i])];

Z[K_] := Z[RVK@K];
Z[rvk_RVK] := (*Z[rvk] =*)Module[{todo,n,rots,ζ,done,st,cx, ζ1, i,j,k,k1,k2,k3},
{todo,rots}=List@@rvk;
AppendTo[rots,0];
n=Length[todo];
ζ=(Subscript[𝔼, {}->{0}])[1,0,ϵSeries@0];
done={0};
st=Range[0,2n+1];
While[{}=!=($M=todo),
{cx}=MaximalBy[todo, Length[done⋂{#[[1]], #[[2]], #[[1]]-1,#[[2]]-1}]&,1];
{i,j}=List@@cx;
ζ1=Switch[Head[cx],
 Xp, ((Subscript[R, i,j])(Subscript[(OverBar[Kink]), k]))//(Subscript[m, j,k->j]),
 Xm, ((Subscript[(OverBar[R]), i,j])(Subscript[Kink, k]))//(Subscript[m, j,k->j])
];
ζ1=(rot[k,rots[[i]]]ζ1)//(Subscript[m, k,i->i]); rots[[i]]=0;
ζ1=(ζ1 rot[k, rots[[i+1]]])//(Subscript[m, i,k->i]); rots[[i+1]]=0;
ζ1=(rot[k,rots[[j]]]ζ1)//(Subscript[m, k,j->j]); rots[[j]]=0;
ζ1=(ζ1 rot[k, rots[[j+1]]])//(Subscript[m, j,k->j]); rots[[j+1]]=0;
ζ*=ζ1;
If[MemberQ[done, i], ζ=ζ//(Subscript[m, i,i+1->i]); st=st/.st[[i+2]]->st[[i+1]]];
If[MemberQ[done, i-1],  ζ=ζ//(Subscript[m, st[[i]],i->st[[i]]]); st=st/.st[[i+1]]->st[[i]]]; 
If[MemberQ[done, j],  ζ=ζ//(Subscript[m, j,j+1->j]); st=st/.st[[j+2]]->st[[j+1]]]; 
If[MemberQ[done, j-1],  ζ=ζ//(Subscript[m, st[[j]],j->st[[j]]]); st=st/.st[[j+1]]->st[[j]]];
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}*))
]