Pensieve Header: Computing the Alexander polynomial in β-calculus, a minimal approach.

<< KnotTheory`
GC[K_] := GC @@ (
PD[K] /. X[i_,j_,k_,l_] :> If[PositiveQ[X[i,j,k,l]],
Ar[l,i,+1], Ar[j,i,-1]
]
)

Alexander[K=Knot[9,42]][X]

βSimplify=Factor;
SetAttributes[βCollect, Listable];
βCollect[B[ω_, μ_]] := B[
βSimplify[ω],
Collect[μ, _h, Collect[#, _t, βSimplify]&]
];
(* "L" for "Labels" *)
hL[β_] := Union[Cases[β, h[s_] :> s, Infinity]];
tL[β_] := Union[Cases[β, t[s_]|(Subscript[c, s_]) :> s, Infinity]];
dL[β_] := Union[hL[β], tL[β]];
SetAttributes[βForm, Listable];
βForm[B[ω_, μ_]] := Module[
{tails, heads, mat},
tails = tL[B[ω, μ]]; heads = hL[B[ω, μ]];
mat = Outer[βSimplify[Coefficient[μ, h[#1] t[#2]]]&, heads, tails];
PrependTo[mat, t /@ tails];
mat = Prepend[Transpose[mat], Prepend[h /@ heads, ω]];
MatrixForm[mat]
];

R[x_, y_] := B[1, (E^(Subscript[c, x])-1)/(Subscript[c, x])*t[x]h[y]];
Rinv[x_, y_] := B[1, (E^(-(Subscript[c, x]))-1)/(Subscript[c, x])*t[x]h[y]];
tm[x_, y_, z_][β_] := β /. {t[x]->t[z], t[y]->t[z], (Subscript[c, x])->(Subscript[c, z]), (Subscript[c, y])->(Subscript[c, z])};
hm[x_, y_, z_][B[ω_, μ_]] := Module[
{γx= D[μ, h[x]], γy=D[μ, h[y]], M=μ /. h[x]|h[y] -> 0},
B[ω, M+h[z](γx+γy+(γx /. t[i_] :> (Subscript[c, i]))γy)] // βCollect
];
swap[x_,y_][B[ω_, μ_]] := Module[
{α, β, γ, δ, ϵ},
α = Coefficient[μ, h[x]t[y]];
β = D[μ, t[y]] /. h[x] -> 0;
γ = D[μ, h[x]] /. t[y] -> 0;
δ = μ /. h[x]|t[y] -> 0;
ϵ = 1+(Subscript[c, y])α;
B[ω*ϵ, Plus[
α(1+(γ /. t[i_] :> (Subscript[c, i]))/ϵ)h[x]t[y],
β(1+(γ /. t[i_] :> (Subscript[c, i]))/ϵ)t[y],
γ/ϵ h[x],
δ-(Subscript[c, y])/ϵ γ*β
]] // βCollect
];
gm[x_,y_,z_][β_] := β // swap[y,x] // hm[x,y,z] // tm[x,y,z];
B /: B[ω1_, μ1_]B[ω2_, μ2_] := B[ω1*ω2, μ1+μ2];

{
β= B[ω[(Subscript[c, 1]),(Subscript[c, 2]),(Subscript[c, 3]),(Subscript[c, 4])],Sum[(Subscript[α, i])[(Subscript[c, 1]),(Subscript[c, 2]),(Subscript[c, 3]),(Subscript[c, 4])]t[i]h[1], {i,4}]],
β // tm[1,2,1],
t1=β // tm[1,2,1] // tm[1,3,1],
t2=β // tm[2,3,28] // tm[1,28,1],
t1==t2
} // βForm

{
β= B[ω,Sum[(Subscript[α, 10i+j])t[i]h[j], {i,2}, {j,4}]],
β // hm[1,2,1],
t1=β // hm[1,2,1] // hm[1,3,1],
t2=β // hm[2,3,28] // hm[1,28,1],
t1==t2
} // βForm // ColumnForm

Clear[β];
{β1=B[ω, h[1]t[1]α+h[2]t[1]β+h[1]t[2]γ+h[2]t[2]δ],
β1 // swap[1,1]
} // βForm

{
β= B[ω,Sum[(Subscript[α, 10i+j])t[i]h[j], {i,2}, {j,3}]],
β // hm[1,2,1],
t1 = β // hm[1,2,1] // swap[1,1],
t2 = β // swap[1,1] // swap[2,1] //  hm[1,2,1],
First[t1]==First[t2],
Last[t1]==Last[t2] // Simplify
} // βForm // ColumnForm

{
β= B[ω,Sum[(Subscript[α, 10i+j])t[i]h[j], {i,3}, {j,2}]],
t1 = β // tm[1,2,1] // swap[1,1],
t2 = β // swap[1,2] // swap[1,1] //  tm[1,2,1],
First[t1]==First[t2],
Last[t1]==Last[t2] // Simplify
} // βForm // ColumnForm

{
β= B[ω,Sum[(Subscript[α, 10i+j])t[i]h[j], {i,4}, {j,4}]],
t1 = β // gm[1,2,1] // gm[1,3,1],
t2 = β // gm[2,3,2] // gm[1,2,1],
First[t1]==First[t2],
Last[t1]==Last[t2] // Simplify
} // βForm // ColumnForm

(β=Times @@ GC[K] /. {Ar[x_,y_,+1] :> R[x,y],  Ar[x_,y_, -1] :> Rinv[x,y]}) // βForm

Table[
β = β // gm[1,k,1],
{k, 2, 2Crossings[K]}
] // βForm // ColumnForm