(* ::Package:: *)

(************************************************************************)
(* This file was generated automatically by the Mathematica front end.  *)
(* It contains Initialization cells from a Notebook file, which         *)
(* typically will have the same name as this file except ending in      *)
(* ".nb" instead of ".m".                                               *)
(*                                                                      *)
(* This file is intended to be loaded into the Mathematica kernel using *)
(* the package loading commands Get or Needs.  Doing so is equivalent   *)
(* to using the Evaluate Initialization Cells menu command in the front *)
(* end.                                                                 *)
(*                                                                      *)
(* DO NOT EDIT THIS FILE.  This entire file is regenerated              *)
(* automatically each time the parent Notebook file is saved in the     *)
(* Mathematica front end.  Any changes you make to this file will be    *)
(* overwritten.                                                         *)
(************************************************************************)



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


(* ::Input::Initialization:: *)
Z[K_] := Z[RVK@K];
Z[rvk_RVK] := (*Z[rvk] =*)Monitor[ \!\(\*SubscriptBox[\(PP\), \("\<Z\>"\)]\)@Module[{todo,n,rots,\[Zeta],done,st,cx, \[Zeta]1, i,j,k,k1,k2,k3},
{todo,rots}=List@@rvk;
AppendTo[rots,0];
n=Length[todo];
\[Zeta]=Subscript[d\[Eta], 0];
done={0};
st=Range[0,2n+1];
While[{}=!=($M=todo),
{cx}=MaximalBy[todo, Length[done\[Intersection]{#[[1]], #[[2]], #[[1]]-1,#[[2]]-1}]&,1];
{i,j}=List@@cx;
\[Zeta]1=Switch[Head[cx],
 Xp, (Subscript[kR, i,j] Subscript[\!\(\*OverscriptBox[\(kKink\), \(_\)]\), k])//Subscript[km, j,k->j],
 Xm, (Subscript[\!\(\*OverscriptBox[\(kR\), \(_\)]\), i,j] Subscript[kKink, k])//Subscript[km, j,k->j]
];
\[Zeta]1=(rot[k,rots[[i]]]\[Zeta]1)//Subscript[km, k,i->i]; rots[[i]]=0;
\[Zeta]1=(\[Zeta]1 rot[k, rots[[i+1]]])//Subscript[km, i,k->i]; rots[[i+1]]=0;
\[Zeta]1=(rot[k,rots[[j]]]\[Zeta]1)//Subscript[km, k,j->j]; rots[[j]]=0;
\[Zeta]1=(\[Zeta]1 rot[k, rots[[j+1]]])//Subscript[km, j,k->j]; rots[[j+1]]=0;
\[Zeta]*=\[Zeta]1;
If[MemberQ[done, i], \[Zeta]=\[Zeta]//Subscript[km, i,i+1->i]; st=st/.st[[i+2]]->st[[i+1]]];
If[MemberQ[done, i-1],  \[Zeta]=\[Zeta]//Subscript[km, st[[i]],i->st[[i]]]; st=st/.st[[i+1]]->st[[i]]]; 
If[MemberQ[done, j],  \[Zeta]=\[Zeta]//Subscript[km, j,j+1->j]; st=st/.st[[j+2]]->st[[j+1]]]; 
If[MemberQ[done, j-1],  \[Zeta]=\[Zeta]//Subscript[km, st[[j]],j->st[[j]]]; st=st/.st[[j+1]]->st[[j]]];
done=done\[Union]{i-1,i,j-1,j};
todo=DeleteCases[todo, cx]
];
CF/@ (\[Zeta] /. {Subscript[x, 0]->x,Subscript[y, 0]->y,Subscript[a, 0]->a})
], $M]


(* ::Input::Initialization:: *)
Z1[K_] := Z1[RVK@K];
Z1[rvk_RVK] := Monitor[ \!\(\*SubscriptBox[\(PP\), \("\<Z\>"\)]\)@Module[{todo,rots,\[Zeta],done,st,cx, \[Zeta]1, i,j,k},
{todo,rots}=List@@rvk;
\[Zeta]=Subscript[d\[Eta], 0];
done={0};
st=Range[0,2Length[todo]];
While[{}=!=($M=todo),
cx=RandomChoice@MaximalBy[todo, Length[done\[Intersection]{#[[1]], #[[2]], #[[1]]-1,#[[2]]-1}]&];
{i,j}=List@@cx;
\[Zeta]1=(cx/.{_Xp:>Subscript[kR, i,j] Subscript[\!\(\*OverscriptBox[\(kKink\), \(_\)]\), 0],_Xm:>Subscript[\!\(\*OverscriptBox[\(kR\), \(_\)]\), i,j] Subscript[kKink, 0]})//Subscript[km, j,0->j];
Do[\[Zeta]1=(rot[0,rots[[k]]]\[Zeta]1)//Subscript[km, 0,k->k], {k,{i,j}}];
\[Zeta]*=\[Zeta]1;
Do[If[MemberQ[done, k], \[Zeta]=\[Zeta]//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\[Union]{i-1,i,j-1,j};
todo=DeleteCases[todo, cx]
];
CF/@ (\[Zeta] /. {Subscript[x, 0]->x,Subscript[y, 0]->y,Subscript[a, 0]->a})
], $M]



