Pensieve header: Finding the Gauss-Gassner-Alexander formula. Seeded at pensieve://2015-07/PolyPoly/.

SetDirectory["C:/drorbn/AcademicPensieve/Talks/NCSU-1604/"];
<< KnotTheory`

Xs[xs_Xs] := xs;
Xs[L_] := Xs@@PD[L] /. X[i_,j_,k_,l_] :> If[PositiveQ[X[i,j,k,l]],Xp[l,i], Xm[j,i]];

ΓCollect[Γ[ω_, λ_]] := Γ[Simplify[ω],
Collect[λ, (Subscript[h, _]), Collect[#,(Subscript[t, _]), Factor]&]];
Format[Γ[ω_,λ_]] := Module[{S, M},
S = Union@Cases[Γ[ω,λ], (Subscript[(h|t), a_]) :> a, ∞];
M = Outer[Factor[(∂_((Subscript[h, #1]),(Subscript[t, #2])))λ]&, S, S];
M = Prepend[M, (Subscript[t, #])& /@ S] // Transpose;
M = Prepend[M, Prepend[(Subscript[h, #])& /@ S, ω]];
M // MatrixForm];

Γ /: Γ[ω1_, λ1_]Γ[ω2_, λ2_] := Γ[ω1*ω2, λ1+λ2];
(Subscript[m, a_,b_->c_])[Γ[ω_, λ_]] := Module[{α,β,γ,δ,θ,ϵ,ϕ,ψ,Ξ,μ},
(({{α, β, θ}, {γ, δ, ϵ}, {ϕ, ψ, Ξ}}))=(({{(∂_((Subscript[t, a]),(Subscript[h, a])))λ, (∂_((Subscript[t, a]),(Subscript[h, b])))λ, (∂_(Subscript[t, a]))λ}, {(∂_((Subscript[t, b]),(Subscript[h, a])))λ, (∂_((Subscript[t, b]),(Subscript[h, b])))λ, (∂_(Subscript[t, b]))λ}, {(∂_(Subscript[h, a]))λ, (∂_(Subscript[h, b]))λ, λ}}))/.(Subscript[(t|h), a|b])->0;
Γ[(μ=1-β)ω, {(Subscript[t, c]),1}.(({{γ+α δ/μ, ϵ+δ θ/μ}, {ϕ+α ψ/μ, Ξ+ψ θ/μ}})).{(Subscript[h, c]),1}]
/. {(Subscript[T, a])->(Subscript[T, c]), (Subscript[T, b])->(Subscript[T, c])} // ΓCollect];
(Subscript[Rp, a_,b_]) := Γ[1, Tr[(({{(Subscript[t, a])}, {(Subscript[t, b])}}))\[Transpose].(({{1, 1-(Subscript[T, a])}, {0, (Subscript[T, a])}})).(({{(Subscript[h, a])}, {(Subscript[h, b])}}))]];
(Subscript[Rm, a_,b_]) := (Subscript[Rp, a,b]) /. (Subscript[T, a])->1/(Subscript[T, a]);
(Subscript[ϵ, a_]) := Γ[1,(Subscript[t, a])(Subscript[h, a])];

ζ=Γ[ω,Tr[(({{(Subscript[t, 1])}, {(Subscript[t, 2])}, {(Subscript[t, 3])}, {(Subscript[t, S])}}))\[Transpose].(({{(Subscript[α, 11]), (Subscript[α, 12]), (Subscript[α, 13]), (Subscript[θ, 1])}, {(Subscript[α, 21]), (Subscript[α, 22]), (Subscript[α, 23]), (Subscript[θ, 2])}, {(Subscript[α, 31]), (Subscript[α, 32]), (Subscript[α, 33]), (Subscript[θ, 3])}, {(Subscript[ϕ, 1]), (Subscript[ϕ, 2]), (Subscript[ϕ, 3]), Ξ}})).(({{(Subscript[h, 1])}, {(Subscript[h, 2])}, {(Subscript[h, 3])}, {(Subscript[h, S])}}))]];
(ζ//(Subscript[m, 1,2->1])//(Subscript[m, 1,3->1]))==(ζ//(Subscript[m, 2,3->2])//(Subscript[m, 1,2->1]))

{(Subscript[Rm, 5,1])(Subscript[Rm, 6,2])(Subscript[Rp, 3,4])//(Subscript[m, 1,4->1])//(Subscript[m, 2,5->2])//(Subscript[m, 3,6->3]),
 (Subscript[Rp, 6,1])(Subscript[Rm, 2,4])(Subscript[Rm, 3,5])//(Subscript[m, 1,4->1])//(Subscript[m, 2,5->2])//(Subscript[m, 3,6->3])}

z=(Subscript[Rm, 12,1])(Subscript[Rm, 2,7])(Subscript[Rm, 8,3])(Subscript[Rm, 4,11])(Subscript[Rp, 16,5])(Subscript[Rp, 6,13])(Subscript[Rp, 14,9])(Subscript[Rp, 10,15]);
Do[z= z // (Subscript[m, 1,k->1]), {k,2,16}];z

Extras

Four types of R1

{(Subscript[Rp, 1,2])//(Subscript[m, 1,2->1]), (Subscript[Rp, 1,2])//(Subscript[m, 2,1->1]), (Subscript[Rm, 1,2])//(Subscript[m, 1,2->1]), (Subscript[Rm, 1,2])//(Subscript[m, 2,1->1])}

Two types of R2

{(Subscript[Rp, 1,2])(Subscript[Rm, 3,4])//(Subscript[m, 1,3->1])//(Subscript[m, 2,4->2]), (Subscript[Rp, 1,2])(Subscript[Rm, 3,4])//(Subscript[m, 1,3->1])//(Subscript[m, 4,2->2])}

Main

Xs[K=Knot[8,17]]

GG[xs_Xs, k_, F_] := Module[{xl,len,y,cuts,pcuts,γ,λ},
xl=List@@xs; len=2Length@xs;
Sum[
cuts=Union@@(List@@@y);
F[
y /. Thread[cuts->Range[Length@cuts]],
γ=(Subscript[ϵ, len+1])Times@@xl /. {Xp[a_,b_] :> (Subscript[Rp, a,b]), Xm[a_,b_] :> (Subscript[Rm, a,b])} /. (Subscript[T, _])->T;
Do[
If[!MemberQ[cuts, j], γ=γ//(Subscript[m, j,j+1->j+1])],
{j,len}
];
λ=γ[[2]];
Table[Simplify[(∂_((Subscript[t, a]),(Subscript[h, b])))λ], {a, cuts⋃{len+1}}, {b,cuts⋃{len+1}}]
],
{y,Subsets[xl,k]}
]
];
GG[K_,k_,F_] := GG[Xs[K],k,F];

GG[K,{1},F] // Short

F1[xs_List, m_] := F[xs, MatrixForm[m /. T->1]];
GG[K,{2},F1] // Short

F0[xs_List, m_] := F[xs, MatrixForm[m]];
GG[K,{1},F0] // Short

FA[{x_}, m_] := Module[{a11,a12,a13,a21,a22,a23,a31,a32,a33},
(({{a11, a12, a13}, {a21, a22, a23}, {a31, a32, a33}})) = m;
Simplify[Times[
If[Head[x]===Xp,+1,-1],
If[x[[1]]==1,((-a23 a32+a22 a33)/(a13 a32+a33-a12 a33)),((a13 a32-a12 a33)/(a32-a23 a32+a22 a33))]
]]
]

GG[K,{1},FA] // Simplify

Alexander[K][T]

Table[
ZK=Times@@Xs[K] /. {Xp[a_,b_] :> (Subscript[Rp, a,b]), Xm[a_,b_] :> (Subscript[Rm, a,b])} /. (Subscript[T, _])->T;
Do[ZK=ZK // (Subscript[m, 1,k->1]),{k,2,2Length[Xs[K]]}];
ZK=ZK[[1]];
alex=Alexander[K][T];
gg=GG[K,{1},FA];
{K,ZK,T*D[Log[ZK],T],gg , alex,gg-T(∂_T)Log[alex]} // Factor // Simplify,
{K, AllKnots[{3,8}]}
] // MatrixForm