Pensieve header: Improving the Z Program.

Startup

Date[]
SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\FullDoPeGDO"];
Once[<<KnotTheory`];
Once[Get@"../Profile/Profile.m"];
BeginProfile[];
$k=1;
<<Engine.m
<<Objects.m
<<KT.m
HL[ℰ_] := Style[ℰ, Background -> If[TrueQ@ℰ,,]];
LogCF[ℰ_]:=ℰ//.{c_ Log[a_]:>Log[(a^c)],Log[a_]+Log[b_]:>Log[a b], Log[a_]:>Log[CF[a]]}

tab5Z=Timing[Table[K->LogCF@Z[K],{K,AllKnots[{3,5}]}]]

Z[K_] := Z[RVK@K];
Z[rvk_RVK] := (*Z[rvk] =*)Monitor[ (Subscript[PP, "Z"])@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[dη, 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[kR, i,j])(Subscript[(OverBar[kKink]), k]))//(Subscript[km, j,k->j]),
 Xm, ((Subscript[(OverBar[kR]), i,j])(Subscript[kKink, k]))//(Subscript[km, j,k->j])
];
ζ1=(rot[k,rots[[i]]]ζ1)//(Subscript[km, k,i->i]); rots[[i]]=0;
ζ1=(ζ1 rot[k, rots[[i+1]]])//(Subscript[km, i,k->i]); rots[[i+1]]=0;
ζ1=(rot[k,rots[[j]]]ζ1)//(Subscript[km, k,j->j]); rots[[j]]=0;
ζ1=(ζ1 rot[k, rots[[j+1]]])//(Subscript[km, j,k->j]); rots[[j+1]]=0;
ζ*=ζ1;
If[MemberQ[done, i], ζ=ζ//(Subscript[km, i,i+1->i]); st=st/.st[[i+2]]->st[[i+1]]];
If[MemberQ[done, i-1],  ζ=ζ//(Subscript[km, st[[i]],i->st[[i]]]); st=st/.st[[i+1]]->st[[i]]]; 
If[MemberQ[done, j],  ζ=ζ//(Subscript[km, j,j+1->j]); st=st/.st[[j+2]]->st[[j+1]]]; 
If[MemberQ[done, j-1],  ζ=ζ//(Subscript[km, 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})
], $M]

Z1[K_] := Z1[RVK@K];
Z1[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]];
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]

tab5Z1=Timing[Table[K->LogCF@Z1[K],{K,AllKnots[{3,5}]}]]

HL[tab5Z[[2]]==tab5Z1[[2]]]

tab7Z=Timing[Table[K->LogCF@Z[K],{K,AllKnots[{3,7}]}]];

tab7Z1=Timing[Table[K->LogCF@Z1[K],{K,AllKnots[{3,7}]}]];
HL[tab7Z[[2]]==tab7Z1[[2]]]

Timing[tab10Z=Table[K->LogCF@Z[K],{K,AllKnots[{3,10}]}];]

Timing[tab10Z1=Table[K->LogCF@Z1[K],{K,AllKnots[{3,10}]}];]
HL[tab10Z[[2]]==tab10Z1[[2]]]