(* ::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:: *)
MatrixSignature[A_]:=Total[Sign[Select[Eigenvalues[A],Abs[#]>10^-12&]]];
Writhe[K_]:=Sum[If[PositiveQ[x],1,-1], {x,List@@PD@K}];


(* ::Input::Initialization:: *)
Bed[K_,\[Omega]_]:=Module[{t,r,XingsByArmpits,bends,faces,p,A,is},
t=1-\[Omega]; r=t+t\[Conjugate];
XingsByArmpits=List@@PD[K]/.x:X[i_,j_,k_,l_]:>If[PositiveQ[x],SubPlus[X][-i,j,k,-l],SubMinus[X][-j,k,l,-i]];
bends=Times@@XingsByArmpits/._[X][a_,b_,c_,d_]:>Subscript[p, a,-d] Subscript[p, b,-a] Subscript[p, c,-b] Subscript[p, d,-c];
faces=bends//.Subscript[p, x__,y_] Subscript[p, y_,z__]:>Subscript[p, x,y,z];
A=Table[0,Length@faces,Length@faces];
Do[is=Position[faces,#][[1,1]]& /@ List@@x;
A[[is,is]]+=If[Head[x]===SubPlus[X],
\!\(
TagBox[
RowBox[{"(", "", GridBox[{
{
RowBox[{"-", "r"}], 
RowBox[{"-", "t"}], 
RowBox[{"2", " ", "t"}], 
RowBox[{"t", "\[Conjugate]"}]},
{
RowBox[{"-", 
RowBox[{"t", "\[Conjugate]"}]}], "0", 
RowBox[{"t", "\[Conjugate]"}], "0"},
{
RowBox[{"2", " ", 
RowBox[{"t", "\[Conjugate]"}]}], "t", 
RowBox[{"-", "r"}], 
RowBox[{"-", 
RowBox[{"t", "\[Conjugate]"}]}]},
{"t", "0", 
RowBox[{"-", "t"}], "0"}
},
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$]]]\),\!\(
TagBox[
RowBox[{"(", "", GridBox[{
{"r", 
RowBox[{"-", "t"}], 
RowBox[{
RowBox[{"-", "2"}], " ", 
RowBox[{"t", "\[Conjugate]"}]}], 
RowBox[{"t", "\[Conjugate]"}]},
{
RowBox[{"-", 
RowBox[{"t", "\[Conjugate]"}]}], "0", 
RowBox[{"t", "\[Conjugate]"}], "0"},
{
RowBox[{
RowBox[{"-", "2"}], "t"}], "t", "r", 
RowBox[{"-", 
RowBox[{"t", "\[Conjugate]"}]}]},
{"t", "0", 
RowBox[{"-", "t"}], "0"}
},
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$]]]\)],
{x,XingsByArmpits}];
MatrixSignature[A] ];


(* ::Input::Initialization:: *)
Kas[K_,\[Omega]_]:=Module[{u,v,XingsByArmpits,bends,faces,p,A,is},
u=Re[\[Omega]^(1/2)]; v= Re[\[Omega]];
XingsByArmpits=List@@PD[K]/.x:X[i_,j_,k_,l_]:>If[PositiveQ[x],SubPlus[X][-i,j,k,-l],SubMinus[X][-j,k,l,-i]];
bends=Times@@XingsByArmpits/._[X][a_,b_,c_,d_]:>Subscript[p, a,-d] Subscript[p, b,-a] Subscript[p, c,-b] Subscript[p, d,-c];
faces=bends//.Subscript[p, x__,y_] Subscript[p, y_,z__]:>Subscript[p, x,y,z];
A=Table[0,Length@faces,Length@faces];
Do[is=Position[faces,#][[1,1]]& /@ List@@x;
A[[is,is]]+=If[Head[x]===SubPlus[X],
\!\(
TagBox[
RowBox[{"(", GridBox[{
{"v", "u", "1", "u"},
{"u", "1", "u", "1"},
{"1", "u", "v", "u"},
{"u", "1", "u", "1"}
},
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$]]]\),\!\(
TagBox[
RowBox[{"-", 
RowBox[{"(", GridBox[{
{"v", "u", "1", "u"},
{"u", "1", "u", "1"},
{"1", "u", "v", "u"},
{"u", "1", "u", "1"}
},
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$]]]\)],
{x,XingsByArmpits}];
(MatrixSignature[A]-Writhe[K])/2 ];



