(* ::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:: *)
<<KnotTheory`


(* ::Input::Initialization:: *)
AlexanderUsingDehn[K_]:=t|->Module[{XingsByArmpits,bends,faces,p,A,is,poly},
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@XingsByArmpits,Length@faces];
Do[is=Position[faces,#][[1,1]]&/@List@@XingsByArmpits[[j]];
A[[{j},is]]+=If[Head[XingsByArmpits[[j]]]===SubPlus[X],
({
 {1, -1, t, -t}
}),({
 {-t, 1, -1, t}
})],
{j,Length@XingsByArmpits}];
poly=A[[All,Delete[Range[Length@faces],{Position[faces,#][[1,1]]}&/@{1,-1}]]]//Det;
((poly/.t->1)poly)/t^Mean[{Exponent[poly,t,Max],Exponent[poly,t,Min]}]//Apart];



