(* ::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:: *)
SetDirectory["C:\\drorbn\\AcademicPensieve\\Classes\\21-1350-KnotTheory"];
<< Common.m


(* ::Input::Initialization:: *)
MT=\!\(\*
TagBox[
RowBox[{"(", "", GridBox[{
{" ", "a", "b", "c", "d"},
{"a", "a", "b", "0", "0"},
{"b", "0", "0", "a", "b"},
{"c", "c", "d", "0", "0"},
{"d", "0", "0", "c", "d"}
},
GridBoxAlignment->{"Columns" -> {{Center}}, "Rows" -> {{Baseline}}},
GridBoxSpacings->{"Columns" -> {Offset[0.27999999999999997`], {Offset[0.7]}, Offset[0.27999999999999997`]}, "Rows" -> {Offset[0.2], {Offset[0.4]}, Offset[0.2]}}], "", ")"}],
Function[BoxForm`e$, MatrixForm[BoxForm`e$]]]\);
\[ScriptCapitalE]_//Subscript[m, i_,j_->k_]:=Expand[\[ScriptCapitalE]]/.Flatten@Table[Subscript[MT[[\[Alpha],1]], i] Subscript[MT[[1,\[Beta]]], j]->(MT[[\[Alpha],\[Beta]]]/.v:(a|b|c|d):>Subscript[v, k]),{\[Alpha],2,5},{\[Beta],2,5}];
Subscript[\[Eta], i_]:=Subscript[a, i]+Subscript[d, i];


(* ::Input::Initialization:: *)
KBasis[i_]:={Subscript[a, i],Subscript[b, i],Subscript[c, i],Subscript[d, i]};
KBasis[i_,is__]:=Flatten@Outer[Times,KBasis[i],KBasis[is]]


(* ::Input::Initialization:: *)
Subscript[R, i_,j_]:=T^(-1/2) (Subscript[a, i] Subscript[a, j]+T Subscript[a, i] Subscript[d, j]+(1-T) Subscript[b, j] Subscript[c, i]+Subscript[d, i] Subscript[a, j]-T Subscript[d, i] Subscript[d, j]);
Subscript[\!\(\*OverscriptBox[\(R\), \(_\)]\), i_,j_]:=T^(1/2) (Subscript[a, i] Subscript[a, j]+T^-1 Subscript[a, i] Subscript[d, j]+(1-T^-1) Subscript[b, j] Subscript[c, i]+Subscript[d, i] Subscript[a, j]-T^-1 Subscript[d, i] Subscript[d, j]);
Subscript[C, i_]:=T^(-1/2) (Subscript[a, i]-Subscript[d, i]); Subscript[\!\(\*OverscriptBox[\(C\), \(_\)]\), i_]:=T^(1/2) (Subscript[a, i]-Subscript[d, i]);


(* ::Input::Initialization:: *)
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\[LeftDoubleBracket]k\[RightDoubleBracket] 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.";


(* ::Input::Initialization:: *)
RVK[pd_PD]:=Module[{n,xs,x,rots,front={1},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=1,k<=2n,++k,
If[FreeQ[front,-k],
front=Flatten@Replace[front,k->(xs/.{
Xp[k,l_]|Xm[l_,k]:>{l+1,k+1,-l},
Xp[l_,k]|Xm[k,l_]:>(++rots[[l]];{-l,k+1,l+1}),
_Xp|_Xm:>{}
}), {1}],
Cases[front,k|-k]/.{k,-k}:>--rots[[k]];
]
];
RVK[xs,rots] ];
RVK[K_]:=RVK[PD[K]];


(* ::Input::Initialization:: *)
Subscript[rot, i_][n_]:=Subscript[rot, i][n]=\[Piecewise]{
 {Subscript[\[Eta], i], n==0},
 {Subscript[C, $]Subscript[rot, i][n-1]// Subscript[m, i,$->i], n>0},
 {Subscript[\!\(\*OverscriptBox[\(C\), \(_\)]\), $]Subscript[rot, i][n+1]// Subscript[m, i,$->i], n<0}
}


(* ::Input::Initialization:: *)
Z[K_] := Z[RVK@K];
Z[rvk_RVK] :=Module[{\[Zeta],done,st,c, \[Chi],i,j,k},
\[Zeta]=1; done={}; st=Range[2Length[rvk[[1]]]];
Do[
{i,j}=List@@c;
\[Chi]=c/.{_Xp:>Subscript[R, i,j],_Xm:>Subscript[\!\(\*OverscriptBox[\(R\), \(_\)]\), i,j]};
Do[\[Chi]=(Subscript[rot, 0][rvk[[2,k]]]\[Chi])//Subscript[m, 0,k->k], {k,{i,j}}];
\[Zeta]*=\[Chi];
Do[
If[MemberQ[done, k+1],\[Zeta]=\[Zeta]//Subscript[m, k,k+1->k]; st=st/.k+1->k];
If[MemberQ[done, k-1],\[Zeta]=\[Zeta]//Subscript[m, st[[k-1]],k->st[[k-1]]]; st=st/.k->st[[k-1]]],
{k,{i,j}}];
done=done\[Union]{i,j},
{c,rvk[[1]]}
];
Factor@\[Zeta]
]



