Pensieve header: The Alexander polynomial using a Seifert formula derived from an $F\times F$ matrix. Continues AlexanderAsFxF.nb of pensieve://Projects/Signatures.

SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\SeifertBox"];
Once[<<KnotTheory`]

PD[epd_EPD]:=PD@@epd/.{(Subscript[X, i_,j_]):>X[j,i+1,j+1,i],(Subscript[(OverBar[X]), i_,j_]):>X[j,i,j+1,i+1]}

Rot[{X_,φ_}]:={X,φ};
Rot[pd_PD]:=Module[{n,xs,x,rots,Xp,Xm,front={1},k},
n=Length@pd;rots=Table[0,{2n+1}];
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]];

(diagram from Talks/CMS-2112)

Alex[K_]:=Module[{ω$,XingsByArmpits,bends,faces,p,A$,is,Cs,φ,SeifertCycles,sc$,drops,keeps},
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]),
(({{(((-1+ω) (1+ω))/(2 ω)), (ω/2), -ω, (1/(2 ω))}, {-(1/(2 ω)), 0, (1/(2 ω)), 0}, {(1/ω), -(ω/2), (((-1+ω) (1+ω))/(2 ω)), -(1/(2 ω))}, {-(ω/2), 0, (ω/2), 0}})),(({{-(((-1+ω) (1+ω))/(2 ω)), (ω/2), -(1/ω), (1/(2 ω))}, {-(1/(2 ω)), 0, (1/(2 ω)), 0}, {ω, -(ω/2), -(((-1+ω) (1+ω))/(2 ω)), -(1/(2 ω))}, {-(ω/2), 0, (ω/2), 0}}))],
{x,XingsByArmpits}];
{Cs,φ}=Rot[PD@K];φ[[-1]]=-1;
SeifertCycles=Times@@(Cs/.{1|-1,i_,j_}:>(Subscript[sc, i,j+1])(Subscript[sc, j,i+1])) //.(Subscript[sc, i__,j_])(Subscript[sc, j_,k__]):>(Subscript[sc, i,j,k])/.(Subscript[sc, i_,j___,i_]):>(Subscript[sc, i,j]);
drops={-1}⋃Cases[SeifertCycles,(Subscript[sc, is__]):>-Total@φ[[{is}]]Min[{is}]];
keeps=Complement[Range@Length@A,FirstPosition[#][faces][[1]]&/@drops];
Factor@Det[A[[keeps,keeps]]/.ω->(T^(1/2))]
]
Table[Simplify[Alex[K]/Alexander[K][T]],{K,AllKnots[{3,11}]}]

Alex[Knot[9,6]]

A//MatrixForm