(* ::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:: *)
Once[<<KnotTheory`];


(* ::Input::Initialization:: *)
tab14=Get["C:\\drorbn\\AcademicPensieve\\Projects\\APAI\\Data\\Rho3-14.m"];
tab14 /. (K_->v_):>(\[Rho][K]=v);


(* ::Input::Initialization:: *)
Rot::usage="Rot[K] where K is any n-crossing knot presentation returns {Cs, \[CurlyPhi]}, where Cs is a length n list of crossings as triples {s,i,j} and \[CurlyPhi] is a lengtth 2n list of rotation numbers.";


(* ::Input::Initialization:: *)
PD[epd_EPD]:=PD@@epd/.{Subscript[X, i_,j_]:>X[j,i+1,j+1,i],Subscript[\!\(\*OverscriptBox[\(X\), \(_\)]\), i_,j_]:>X[j,i,j+1,i+1]}


(* ::Input::Initialization:: *)
Rot[pd_PD]:=Module[{n,xs,x,rots,Xp,Xm,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]];
]
];
{xs/.{Xp[i_,j_]:>{+1,i,j}, Xm[i_,j_]:>{-1,i,j}},rots} ];
Rot[K_]:=Rot[PD[K]];


(* ::Input::Initialization:: *)
Subscript[R, 1][s_,i_,j_]:=s(Subscript[g, j\[InvisibleComma]i](Subscript[g, j+1,j]+Subscript[g, j,j+1]-Subscript[g, i\[InvisibleComma]j])-Subscript[g, i\[InvisibleComma]i](Subscript[g, j,j+1]-1)-1/2);
\[Rho][K_]:=\[Rho][K]=Module[{Cs,\[CurlyPhi],n,A,s,i,j,k,\[CapitalDelta],G,\[Rho]1},
{Cs,\[CurlyPhi]}=Rot[K]; n=Length[Cs];
A=IdentityMatrix[2n+1];
Cases[Cs,{s_,i_,j_}:>(A[[{i,j},{i+1,j+1}]]+=({
 {-T^s, T^s-1},
 {0, -1}
}))];
\[CapitalDelta]=T^((-Total[\[CurlyPhi]]-Total[Cs[[All,1]]])/2) Det[A];
G=Inverse[A];
\[Rho]1=\!\(
\*SubsuperscriptBox[\(\[Sum]\), \(k = 1\), \(n\)]\(
\*SubscriptBox[\(R\), \(1\)] @@ Cs[[k]]\)\) - \!\(
\*SubsuperscriptBox[\(\[Sum]\), \(k = 1\), \(2  n\)]\(\[CurlyPhi][[k]] \((
\*SubscriptBox[\(g\), \(k\[InvisibleComma]k\)] - 1/2)\)\)\);
Factor@{\[CapitalDelta],\[CapitalDelta]^2 \[Rho]1/.Subscript[g, \[Alpha]_,\[Beta]_]:>G[[\[Alpha],\[Beta]]]}];


(* ::Input::Initialization:: *)
Ribbons={Knot[0,1],Knot[6,1],Knot[8,8],Knot[8,9],Knot[8,20],Knot[9,27],Knot[9,41],Knot[9,46],Knot[10,3],Knot[10,22],Knot[10,35],Knot[10,42],Knot[10,48],Knot[10,75],Knot[10,87],Knot[10,99],Knot[10,123],Knot[10,129],Knot[10,137],Knot[10,140],Knot[10,153],Knot[10,155]}



