Pensieve Header: Meta-group calculus in the Burau presentation; continues pensieve://2012-03/.

<< 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]
]
)

BuSimplify=Simplify;
SetAttributes[BuCollect, Listable];
BuCollect[Bu[ω_, μ_]] := Bu[
BuSimplify[ω],
Collect[μ, _h, Collect[#, _t, BuSimplify]&]
];
L[β_] := Union[Cases[β, h[s_]|t[s_]|(Subscript[T, s_]) :> s, Infinity]];
BuForm[Bu[ω_, μ_]] := Module[
{labels, mat},
labels = L[Bu[ω, μ]];
mat = Outer[BuSimplify[Coefficient[μ, h[#1] t[#2]]]&, labels, labels];
PrependTo[mat, t /@ labels];
mat = Prepend[Transpose[mat], Prepend[h /@ labels, ω]];
MatrixForm[mat]
];
BuForm[else_] := else /. β_Bu :> BuForm[β];

⟨α_⟩ := α /. t[_] -> 1;
m[x_,y_,z_][Bu[ω_, μ_]] := Module[
{α,β,γ,δ,ϵ,η,θ},
α = Coefficient[μ, t[x]h[y]];
β = Coefficient[μ, t[x]] /. h[y] -> 0;
γ = Coefficient[μ, t[y]h[x]];
δ = Coefficient[μ, t[y]] /. h[x] -> 0;
ϵ = Coefficient[μ, h[x]] /. t[y] -> 0;
η = Coefficient[μ, h[y]] /. t[x] -> 0;
θ = μ /. t[x]|t[y]|h[x]|h[y] -> 0;
(Bu[ω(1-α),
t[z](δ+β(1+⟨η⟩/(α-1)))+h[z](ϵ+η(γ+⟨ϵ⟩)/(α-1))
+θ-(Expand[η*β] /. t[s_]h[s_] -> 0)/(α-1)
] /. (Subscript[T, x])|(Subscript[T, y])->(Subscript[T, z])) // BuCollect
];
Bu /: Bu[ω1_, μ1_]*Bu[ω2_, μ2_] := Bu[ω1*ω2, μ1+μ2];
Rp[x_,y_]:=Bu[1, t[x]h[y] (1-(Subscript[T, x]))];
Rm[x_,y_]:=Bu[1, t[x]h[y] (1-1/(Subscript[T, x]))];

{β=Times@@(GD[Knot[8,17]] /. {Ar[x_,y_, 1] :> Rp[x,y], Ar[x_,y_,-1] :> Rm[x,y]}),
β // BuForm,
Do[β=m[1,k,1][β], {k,2,16}]; β // BuForm,
Alexander[Knot[8,17]][(Subscript[T, 1])]
} // ColumnForm

BuZ[K_] := Module[{β},
β=Times@@(GD[K] /. {Ar[x_,y_, 1] :> Rp[x,y], Ar[x_,y_,-1] :> Rm[x,y]});
Do[β=m[1,k,1][β], {k,2,2Crossings[K]}];
β[[1]]
];
BuZ[Knot[8,17]]

Factor[Alexander[#][(Subscript[T, 1])]/BuZ[#]]& /@ AllKnots[{3,7}]

n=5;
{
β1=Bu[ω,
Sum[(Subscript[α, 10i+j]) t[i]h[j]-(Subscript[α, 11j])/n*t[j]h[j], {i,n}, {j,n}]
],
β1 // m[1,2,1]
} // BuForm // ColumnForm

n=5;
{
β1=Bu[ω,
Sum[(Subscript[α, 10i+j]) t[i]h[j]-(Subscript[α, 11j])/n*t[j]h[j], {i,n}, {j,n}]
],
β2 = (((β1 /. Bu[ω_, μ_] :> Bu[ω, μ/ω]) // m[1,2,1]) /. Bu[ω_, μ_] :> Bu[ω, μ*ω]),
Collect[⟨β2[[2]]⟩, _h, FullSimplify],
Collect[β2[[2]] /. _h -> 1, _t, FullSimplify]
} // BuForm // ColumnForm