(* ::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\\Projects\\APAI"];
Once[
<<KnotTheory`;
<< Rot.m
];


(* ::Input::Initialization:: *)
AlexanderMatrices[K_]:=Module[{},
{Cs,\[Rho]}=Rot[K]; n=Length[Cs];
 \[Nu]={l\[Nu]=0};
For[k=1,k<=2n,++k,Cs/.{{s_,k,j_}:>AppendTo[\[Nu],l\[Nu]+=s],{s_,i_,k}:>AppendTo[\[Nu],l\[Nu]-=s]}];
\[Nu]=DiagonalMatrix[T^\[Nu]]; \[Nu]i=Inverse@\[Nu];
A0=Table[0,2n+1,2n+1]; A0[[2n+1,2n+1]]=1;
C2=C1=A\[Pi]=A1=A2=A3=A4=A0;
P1=RotateLeft[IdentityMatrix[2n+1]];
(*P1=Table[0,2n+1,2n+1]; Do[P1\[LeftDoubleBracket]i,i+1\[RightDoubleBracket]=1,{i,2n}];*)
P2=IdentityMatrix[2n+1]; Do[P2[[i,1]]=-1,{i,2,2n+1}];
Subscript[E, i_,j_]:=ReplacePart[Table[0,2n+1,2n+1],{i,j}->1];
Cases[Cs,{s_Integer,i_,j_}:>(A\[Pi][[{i,j},{i,j,i+1,j+1}]]=({
 {1, 0, -1, 0},
 {0, 1, T^s-1, -T^s}
});A0[[{i,j},{i,j,i+1,j+1}]]=({
 {1, 0, -T^s, T^s-1},
 {0, 1, 0, -1}
});
C1[[{i,j},{i,j}]]=({
 {-T^-s, T^-s-1},
 {0, -1}
}); C2[[{i,j},{i,j}]]=({
 {-T^-s, 0},
 {T^-s-1, -1}
});
A1[[{i,j},{i,j,i+1,j+1}]]=({
 {-T^-s, T^-s-1, 1, 0},
 {0, -1, 0, 1}
}); A2[[{i,j,i+1,j+1},{i,j}]]=\!\(\*
TagBox[
RowBox[{"(", "", GridBox[{
{
RowBox[{"-", 
SuperscriptBox["T", 
RowBox[{"-", "s"}]]}], "0"},
{
RowBox[{
SuperscriptBox["T", 
RowBox[{"-", "s"}]], "-", "1"}], 
RowBox[{"-", "1"}]},
{"1", "0"},
{"0", "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$]]]\);
A3[[{i,j},{i,j,i+1,j+1}]]=({
 {1, 0, -T^-s, 0},
 {0, 1, T^-s-1, -1}
}); A4[[{i,j},{i,j,i+1,j+1}]]=({
 {1, 0, -1, 0},
 {0, 1, T^-s-1, -T^-s}
});)]; ]
AlexanderMatrices[Knot[10,165]]
Det/@{A\[Pi],A0,A1,A2,A3,A4}
Simplify[{C1 . A0==A1,(C1 . A0)\[Transpose]==A2, A0\[Transpose] . C2 . P1+Subscript[E, 1,1]==A3, \[Nu]i . A0\[Transpose] . C2 . P1 . \[Nu]+Subscript[E, 1,1]==A4,\[Nu]i . A0\[Transpose] . C2 . P1 . \[Nu] . P2==(A\[Pi]/.T->T^-1)}]


(* ::Input::Initialization:: *)
QF[m_?MatrixQ]:=Sum[Factor[m[[i,j]]]Subscript[x, i] Subscript[p, j],{i,2n+1},{j,2n+1}]



