Pensieve Header: Finding the MVA in the β-framework.

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

Draw[expr_] := expr /. gd_GD:> Draw[gd];
Draw[gd_GD] := Module[
{n=Length[gd], h, k=0},
Graphics[{
Line[{{0,0}, {2n+1,0}}],
Table[Text[i, {i,-0.3}], {i,2n}],
(List@@gd) /.  {
Ar[i_, j_, s_] :> {
h=Abs[i-j]/2;
BezierCurve[{
{i,0},{i,h}, {(i+j)/2, h}, {j,h}, {j,0}
}, SplineDegree -> 2],
Text[s*(++k), {(i+j)/2, h-0.3}],
Line[{{j-0.2, 0.4}, {j,0}, {j+0.2, 0.4}}]
}
}
}
]
];
Draw[GD[Knot[8,17]]]

β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[T, 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, ((Subscript[T, x])-1)t[x]h[y]];
Rinv[x_, y_] := B[1, (1/(Subscript[T, x])-1)t[x]h[y]];
tm[x_, y_, z_][β_] := β /. {t[x]->t[z], t[y]->t[z], (Subscript[T, x])->(Subscript[T, z]), (Subscript[T, y])->(Subscript[T, 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_] :> 1)γ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+α;
B[ω*ϵ, Plus[
α(1+(γ /. t[i_] :> 1)/ϵ)h[x]t[y],
β(1+(γ /. t[i_] :> 1)/ϵ)t[y],
γ/ϵ h[x],
δ-(1/ϵ) γ*β
]] // β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];

{
{L=Link["L9n1"], skel=Skeleton[L], MultivariableAlexander[L][X] // Factor, Draw[GD[L]]},
(β=Times @@ GD[L] /. {Ar[x_,y_,+1] :> R[x,y],  Ar[x_,y_, -1] :> Rinv[x,y]}) // βForm,
Do[
Do[
β = β // gm[skel[[s,1]], skel[[s,k]], skel[[s,1]]],
{k, 2, Length[skel[[s]]]}
],
{s, Length[skel]}
];
β // βForm
} // ColumnForm

βMVA[L_Link] := Module[
{skel, β, s, k},
skel=Skeleton[L];
β=Times @@ GD[L] /. {Ar[x_,y_,+1] :> R[x,y],  Ar[x_,y_, -1] :> Rinv[x,y]};
Do[
Do[
β = β // gm[skel[[s,1]], skel[[s,k]], skel[[s,1]]],
{k, 2, Length[skel[[s]]]}
],
{s, Length[skel]}
];
β
]

Table[{
skel=Skeleton[L];
poly=(MultivariableAlexander[L][X] /. X[i_] :> (Subscript[T, skel[[i,1]]]) // Numerator // Factor),
{ω, μ} = List@@βMVA[L];
(B[ω, ω*μ] /. t[s_] :> t[s]/((Subscript[T, s])-1))// βForm;
tails = tL[B[ω, μ]]; heads = hL[B[ω, μ]]; vars=((Subscript[T, #]))& /@ tails;
mat = Transpose[Outer[βSimplify[Coefficient[ω*μ /. t[s_] :> t[s]/((Subscript[T, s])-1), h[#1] t[#2]]]&, heads, tails]];
nums= DeleteCases[Numerator /@ Flatten[mat], 0];
bas=GroebnerBasis[Append[nums, ω], vars];
PolynomialReduce[poly, bas, vars]
}, {L, Take[AllLinks[9, NonAlternating],All]}] // ColumnForm

PolynomialReduce[(-1+(Subscript[T, 1])) (((-1+(Subscript[T, 5])))^2) (1+(Subscript[T, 5]) (Subscript[T, 15]))(Subscript[T, 1])^3  (Subscript[T, 5])^3  (Subscript[T, 15])^3,
{(-1+(Subscript[T, 5])) (-1+(Subscript[T, 1])+(Subscript[T, 5])-(Subscript[T, 1]) (Subscript[T, 5])-(Subscript[T, 5]^2)+(Subscript[T, 1]) (Subscript[T, 5]^2)-(Subscript[T, 1]) (Subscript[T, 5]^3)-(Subscript[T, 5]) (Subscript[T, 15])+(Subscript[T, 1]) (Subscript[T, 5]) (Subscript[T, 15])+(Subscript[T, 5]^2) (Subscript[T, 15])-(Subscript[T, 1]) (Subscript[T, 5]^2) (Subscript[T, 15])+(Subscript[T, 1]) (Subscript[T, 5]^3) (Subscript[T, 15])),-(Subscript[T, 1]) (((-1+(Subscript[T, 5])))^2) (Subscript[T, 5]),-(Subscript[T, 5]) (-(Subscript[T, 5])-(Subscript[T, 15])+(Subscript[T, 5]) (Subscript[T, 15])-(Subscript[T, 1]) (Subscript[T, 5]) (Subscript[T, 15])-(Subscript[T, 5]^2) (Subscript[T, 15])+(Subscript[T, 1]) (Subscript[T, 5]^2) (Subscript[T, 15])),
(((-1+(Subscript[T, 5])))^2) (-1+(Subscript[T, 5])-(Subscript[T, 5]^2)-(Subscript[T, 5]) (Subscript[T, 15])+(Subscript[T, 5]^2) (Subscript[T, 15])), (Subscript[T, 1]) (Subscript[T, 5]^2)-(Subscript[T, 15])+2 (Subscript[T, 1]) (Subscript[T, 15])-(Subscript[T, 1]^2) (Subscript[T, 15])+(Subscript[T, 5]) (Subscript[T, 15])-2 (Subscript[T, 1]) (Subscript[T, 5]) (Subscript[T, 15])+2 (Subscript[T, 1]^2) (Subscript[T, 5]) (Subscript[T, 15])-(Subscript[T, 5]^2) (Subscript[T, 15])+2 (Subscript[T, 1]) (Subscript[T, 5]^2) (Subscript[T, 15])-(Subscript[T, 1]^2) (Subscript[T, 5]^2) (Subscript[T, 15])-(Subscript[T, 1]) (Subscript[T, 5]^3) (Subscript[T, 15])+(Subscript[T, 1]^2) (Subscript[T, 5]^3) (Subscript[T, 15])+(Subscript[T, 1]) (Subscript[T, 5]^4) (Subscript[T, 15])-(Subscript[T, 1]^2) (Subscript[T, 5]^4) (Subscript[T, 15])-(Subscript[T, 5]) (Subscript[T, 15]^2)+(Subscript[T, 1]) (Subscript[T, 5]) (Subscript[T, 15]^2)-(Subscript[T, 1]^2) (Subscript[T, 5]) (Subscript[T, 15]^2)+(Subscript[T, 5]^2) (Subscript[T, 15]^2)-2 (Subscript[T, 1]) (Subscript[T, 5]^2) (Subscript[T, 15]^2)+(Subscript[T, 1]^2) (Subscript[T, 5]^2) (Subscript[T, 15]^2)+(Subscript[T, 1]) (Subscript[T, 5]^3) (Subscript[T, 15]^2)-(Subscript[T, 1]^2) (Subscript[T, 5]^3) (Subscript[T, 15]^2)-(Subscript[T, 1]) (Subscript[T, 5]^4) (Subscript[T, 15]^2)+(Subscript[T, 1]^2) (Subscript[T, 5]^4) (Subscript[T, 15]^2)-(Subscript[T, 1]^2) (Subscript[T, 15]^3)-(Subscript[T, 1]) (Subscript[T, 5]^2) (Subscript[T, 15]^3), -(-1+(Subscript[T, 5])) (Subscript[T, 5]^3)},
{(Subscript[T, 1]), (Subscript[T, 5]), (Subscript[T, 15])}
]

{-(Subscript[T, 5])+(Subscript[T, 5]^2)+(Subscript[T, 1]) (Subscript[T, 11])+2 (Subscript[T, 5]) (Subscript[T, 11])-2 (Subscript[T, 1]) (Subscript[T, 5]) (Subscript[T, 11])-(Subscript[T, 5]^2) (Subscript[T, 11])-(Subscript[T, 1]) (Subscript[T, 11]^2)+(Subscript[T, 1]) (Subscript[T, 5]) (Subscript[T, 11]^2),((1-(Subscript[T, 1])-(Subscript[T, 5])+(Subscript[T, 1]) (Subscript[T, 11]))/(Subscript[T, 5])),(({{1, h[1], h[5], h[11]}, {t[1], -((-1+(Subscript[T, 11]))/(Subscript[T, 5])), -(1/((Subscript[T, 1]) (Subscript[T, 5]) (Subscript[T, 11]))), (1/((Subscript[T, 5]) (Subscript[T, 11])))}, {t[5], -((-(Subscript[T, 1])+(Subscript[T, 11])+(Subscript[T, 1]) (Subscript[T, 11]))/(Subscript[T, 5])), -(((Subscript[T, 1])-(Subscript[T, 11])-(Subscript[T, 1]) (Subscript[T, 11])+(Subscript[T, 1]) (Subscript[T, 11]^2))/((Subscript[T, 1]) (Subscript[T, 5]) (Subscript[T, 11]))), (((Subscript[T, 1])-(Subscript[T, 5])-(Subscript[T, 11])+(Subscript[T, 5]) (Subscript[T, 11]))/((Subscript[T, 5]) (Subscript[T, 11])))}, {t[11], ((-1+(Subscript[T, 5])+(Subscript[T, 1]) (Subscript[T, 5]))/(Subscript[T, 5])), ((1-(Subscript[T, 1]) (Subscript[T, 5])-(Subscript[T, 1]) (Subscript[T, 11])+(Subscript[T, 1]) (Subscript[T, 5]) (Subscript[T, 11]))/((Subscript[T, 1]) (Subscript[T, 5]) (Subscript[T, 11]))), -((1-(Subscript[T, 5])+(Subscript[T, 5]^2))/((Subscript[T, 5]) (Subscript[T, 11])))}}))// MatrixForm}

PolynomialReduce[(-(Subscript[T, 5])+(Subscript[T, 5]^2)+(Subscript[T, 1]) (Subscript[T, 11])+2 (Subscript[T, 5]) (Subscript[T, 11])-2 (Subscript[T, 1]) (Subscript[T, 5]) (Subscript[T, 11])-(Subscript[T, 5]^2) (Subscript[T, 11])-(Subscript[T, 1]) (Subscript[T, 11]^2)+(Subscript[T, 1]) (Subscript[T, 5]) (Subscript[T, 11]^2))((Subscript[T, 1])^3  (Subscript[T, 5])^3  (Subscript[T, 11])^3),
{-(Subscript[T, 1])+(Subscript[T, 11])+(Subscript[T, 1]) (Subscript[T, 11]), -1+(Subscript[T, 5])+(Subscript[T, 1]) (Subscript[T, 5]), 1-(Subscript[T, 1]) (Subscript[T, 5])-(Subscript[T, 1]) (Subscript[T, 11])+(Subscript[T, 1]) (Subscript[T, 5]) (Subscript[T, 11]), -1+(Subscript[T, 11]), (Subscript[T, 1])-(Subscript[T, 11])-(Subscript[T, 1]) (Subscript[T, 11])+(Subscript[T, 1]) (Subscript[T, 11]^2),1-(Subscript[T, 5])+(Subscript[T, 5]^2)},
{(Subscript[T, 1]), (Subscript[T, 5]), (Subscript[T, 11])}
]

Det[(({{-((-(Subscript[T, 1])+(Subscript[T, 11])+(Subscript[T, 1]) (Subscript[T, 11]))/(Subscript[T, 5])), -(((Subscript[T, 1])-(Subscript[T, 11])-(Subscript[T, 1]) (Subscript[T, 11])+(Subscript[T, 1]) (Subscript[T, 11]^2))/((Subscript[T, 1]) (Subscript[T, 5]) (Subscript[T, 11])))}, {((-1+(Subscript[T, 5])+(Subscript[T, 1]) (Subscript[T, 5]))/(Subscript[T, 5])), ((1-(Subscript[T, 1]) (Subscript[T, 5])-(Subscript[T, 1]) (Subscript[T, 11])+(Subscript[T, 1]) (Subscript[T, 5]) (Subscript[T, 11]))/((Subscript[T, 1]) (Subscript[T, 5]) (Subscript[T, 11])))}}))]*(Subscript[T, 1]) (Subscript[T, 5])^2 (Subscript[T, 11]) // Expand

Factor /@ {-(Subscript[T, 1])+(Subscript[T, 11])+(Subscript[T, 1]) (Subscript[T, 11]), -1+(Subscript[T, 5])+(Subscript[T, 1]) (Subscript[T, 5]), 1-(Subscript[T, 1]) (Subscript[T, 5])-(Subscript[T, 1]) (Subscript[T, 11])+(Subscript[T, 1]) (Subscript[T, 5]) (Subscript[T, 11]), -1+(Subscript[T, 11]), (Subscript[T, 1])-(Subscript[T, 11])-(Subscript[T, 1]) (Subscript[T, 11])+(Subscript[T, 1]) (Subscript[T, 11]^2),1-(Subscript[T, 5])+(Subscript[T, 5]^2)}

β /. B[ω_, μ_] :> (
tails = tL[B[ω, μ]]; heads = hL[B[ω, μ]];
mat = Outer[βSimplify[Coefficient[ω*μ, h[#1] t[#2]]]&, heads, tails] // Transpose;
Numerator /@ Flatten[mat]
)

Numerator[0]

PolynomialReduce[12+x,{0,x}, {x}]

{
t1=Factor[MultivariableAlexander[#, Program -> "MVA1"][X]],
t2=MultivariableAlexander[#, Program -> "MVA2"][X],
Simplify[t1/t2], Simplify[(t1 /. {X[1]->X[2], X[2]->X[1]})/t2], Simplify[(t1 /. {X[1]->X[2], X[2]->X[3], X[3] -> X[1]})/t2]
}& /@ AllLinks[9, NonAlternating] /. X[i_] :> (Subscript[X, i]) // MatrixForm