The .nb (source) file is at http://www.math.toronto.edu/vohuan/, based on the original program at http://drorbn.net/AcademicPensieve/2015-07/PolyPoly/.

Alexander Invariant of Tangles

1. Γ-Calculus

The following code expresses an element of Γ calculus in a nice format.

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

For instance, we can display an element of Γ calculus as follows.

Γ[ω,{(Subscript[y, a]),(Subscript[y, b])}.(({{(Subscript[g, 11]), (Subscript[g, 12])}, {(Subscript[g, 21]), (Subscript[g, 22])}})).{(Subscript[x, a]),(Subscript[x, b])}]

Next we program the stitching operation

Γ /: Γ[ω1_, λ1_]Γ[ω2_, λ2_] := Γ[ω1*ω2, λ1+λ2];
(Subscript[m, a_,e_->c_])[Γ[ω_, λ_]] := Module[{α,β,γ,δ,θ,ϵ,ϕ,ψ,Ξ,μ},
(({{α, β, θ}, {γ, δ, ϵ}, {ϕ, ψ, Ξ}}))=(({{(∂_((Subscript[y, a]),(Subscript[x, a])))λ, (∂_((Subscript[y, a]),(Subscript[x, e])))λ, (∂_(Subscript[y, a]))λ}, {(∂_((Subscript[y, e]),(Subscript[x, a])))λ, (∂_((Subscript[y, e]),(Subscript[x, e])))λ, (∂_(Subscript[y, e]))λ}, {(∂_(Subscript[x, a]))λ, (∂_(Subscript[x, e]))λ, λ}}))/.(Subscript[(y|x), a|e])->0;
Γ[(μ=1-γ)ω, {(Subscript[y, c]),1}.(({{β+α δ/μ, θ+α ϵ/μ}, {ψ+δ ϕ/μ, Ξ+ϕ ϵ/μ}})).{(Subscript[x, c]),1}]
/. {(Subscript[t, a])->(Subscript[t, c]), (Subscript[t, e])->(Subscript[t, c])} // ΓCollect];
(Subscript[R, a_,e_]^(+)) := Γ[1, {(Subscript[y, a]),(Subscript[y, e])}.(({{1, 1-(Subscript[t, a])}, {0, (Subscript[t, a])}})).{(Subscript[x, a]),(Subscript[x, e])}];
(Subscript[R, a_,e_]^(-)) := (Subscript[R, a,e]^(+)) /. (Subscript[t, a])->1/(Subscript[t, a]);

Checking meta-associativity

ζ=Γ[ω, {(Subscript[y, 1]),(Subscript[y, 2]),(Subscript[y, 3]),(Subscript[y, S])}.(({{(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[x, 1]),(Subscript[x, 2]),(Subscript[x, 3]),(Subscript[x, S])}]

(ζ//(Subscript[m, 1,2->1])//(Subscript[m, 1,3->1]))==(ζ//(Subscript[m, 2,3->2])//(Subscript[m, 1,2->1]))

Checking the RIII relation

(Subscript[R, 1,4]^(+))(Subscript[R, 2,5]^(+))(Subscript[R, 6,3]^(-))//(Subscript[m, 1,6->1])//(Subscript[m, 2,4->2])//(Subscript[m, 3,5->3])

(Subscript[R, 1,4]^(-))(Subscript[R, 5,2]^(+))(Subscript[R, 6,3]^(+))//(Subscript[m, 1,5->1])//(Subscript[m, 2,6->2])//(Subscript[m, 3,4->3])

Checking the RII relations

(Subscript[R, i,j]^(+))(Subscript[R, k,l]^(-))//(Subscript[m, i,k->i])//(Subscript[m, j,l->j])

Checking the Overcrossings Commute (OC) relation

(Subscript[R, 4,2]^(+))(Subscript[R, 1,3]^(+))//(Subscript[m, 1,4->1])

(Subscript[R, 4,3]^(+))(Subscript[R, 1,2]^(+))//(Subscript[m, 1,4->1])

Compute the invariant of the figure-eight knot

(Subscript[R, 1,6]^(+))(Subscript[R, 5,2]^(+))(Subscript[R, 3,8]^(-))(Subscript[R, 7,4]^(-))//(Subscript[m, 1,2->1])//(Subscript[m, 1,3->1])//(Subscript[m, 1,4->1])//(Subscript[m, 1,5->1])//(Subscript[m, 1,6->1])//(Subscript[m, 1,7->1])//(Subscript[m, 1,8->1])

As another example, let us compute the invariant of the following tangle

(Subscript[R, 7,2]^(+))(Subscript[R, 10,6]^(-))(Subscript[R, 5,11]^(-))(Subscript[R, 3,12]^(-))(Subscript[R, 4,8]^(+))(Subscript[R, 9,1]^(+))//(Subscript[m, 1,4->1])//(Subscript[m, 2,5->2])//(Subscript[m, 2,6->2])//(Subscript[m, 2,7->2])//(Subscript[m, 3,8->3])//(Subscript[m, 3,9->3])//(Subscript[m, 3,10->3])//(Subscript[m, 3,11->3])//(Subscript[m, 3,12->3])

Now let us compute the invariant of the knot (Subscript[7, 7]) in the Knot Atlas.

First we compute the invariant of the tangle inside the circle

(Subscript[τ, 1])=(Subscript[R, 1,2]^(+))(Subscript[R, 14,4]^(+))(Subscript[R, 5,13]^(-))(Subscript[R, 3,6]^(-))(Subscript[R, 12,9]^(-))(Subscript[R, 7,11]^(+))(Subscript[R, 10,8]^(+))//(Subscript[m, 1,4->1])//(Subscript[m, 2,5->2])//(Subscript[m, 2,6->2])//(Subscript[m, 2,7->2])//(Subscript[m, 2,8->2])//(Subscript[m, 3,9->3])//(Subscript[m, 3,10->3])//(Subscript[m, 3,11->3])//(Subscript[m, 3,12->3])//(Subscript[m, 3,13->3])//(Subscript[m, 3,14->3])

The to obtain the invariant of the knot we perform two extra stitchings

(Subscript[τ, 1])//(Subscript[m, 2,1->2])//(Subscript[m, 3,2->1])

2. Extended Γ-Calculus

First we format extended Γ-calculus

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

For example

eΓ[1, {(Subscript[y, a]),(Subscript[y, e])}.(({{1, 1-(Subscript[t, a])}, {0, (Subscript[t, a])}})).{(Subscript[x, a]),(Subscript[x, e])},{(Subscript[s, a]),(Subscript[s, e])}.{(Subscript[v, a]),(Subscript[v, e])}]

Extended stitching

eΓ /: eΓ[ω1_, λ1_,σ1_]eΓ[ω2_, λ2_,σ2_] := eΓ[ω1*ω2, λ1+λ2,σ1+σ2];
(Subscript[em, a_,e_->c_])[eΓ[ω_, λ_,σ_]] := Module[{α,β,γ,δ,θ,ϵ,ϕ,ψ,Ξ,μ},
(({{α, β, θ}, {γ, δ, ϵ}, {ϕ, ψ, Ξ}}))=(({{(∂_((Subscript[y, a]),(Subscript[x, a])))λ, (∂_((Subscript[y, a]),(Subscript[x, e])))λ, (∂_(Subscript[y, a]))λ}, {(∂_((Subscript[y, e]),(Subscript[x, a])))λ, (∂_((Subscript[y, e]),(Subscript[x, e])))λ, (∂_(Subscript[y, e]))λ}, {(∂_(Subscript[x, a]))λ, (∂_(Subscript[x, e]))λ, λ}}))/.(Subscript[(y|x), a|e])->0;
eΓ[(μ=1-γ)ω, {(Subscript[y, c]),1}.(({{β+α δ/μ, θ+α ϵ/μ}, {ψ+δ ϕ/μ, Ξ+ϕ ϵ/μ}})).{(Subscript[x, c]),1},
(σ/.(Subscript[v, a|e])->0)+(Subscript[v, c])((∂_(Subscript[v, a]))σ)((∂_(Subscript[v, e]))σ)]
/. {(Subscript[t, a])->(Subscript[t, c]), (Subscript[t, e])->(Subscript[t, c]),(Subscript[b, a])->(Subscript[b, c]),(Subscript[b, e])->(Subscript[b, c])}//eΓCollect];
(Subscript[eR, a_,e_]^(+)) := eΓ[1, {(Subscript[y, a]),(Subscript[y, e])}.(({{1, 1-(Subscript[t, a])}, {0, (Subscript[t, a])}})).{(Subscript[x, a]),(Subscript[x, e])},(Subscript[v, a])+(Subscript[t, a])(Subscript[v, e])];
(Subscript[eR, a_,e_]^(-)) := (Subscript[eR, a,e]^(+)) /. (Subscript[t, a])->(Subscript[t, a]^(-1));

Cheking meta-associativity

eζ=eΓ[ω, {(Subscript[y, 1]),(Subscript[y, 2]),(Subscript[y, 3]),(Subscript[y, S])}.(({{(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[x, 1]),(Subscript[x, 2]),(Subscript[x, 3]),(Subscript[x, S])},(Subscript[s, 1])(Subscript[v, 1])+(Subscript[s, 2])(Subscript[v, 2])+(Subscript[s, 3])(Subscript[v, 3])+(Subscript[s, S])(Subscript[v, S])]

(eζ//(Subscript[em, 1,2->1])//(Subscript[em, 1,3->1]))≡(eζ//(Subscript[em, 2,3->2])//(Subscript[em, 1,2->1]))

Strand reversal

dH[a_][eΓ[ω_, λ_,σ_]] := Module[{α,θ,ϕ,Ξ,sa},
(({{α, θ}, {ϕ, Ξ}}))=(({{(∂_((Subscript[y, a]),(Subscript[x, a])))λ, (∂_(Subscript[y, a]))λ}, {(∂_(Subscript[x, a]))λ, λ}}))/.(Subscript[(y|x), a])->0;
sa = (∂_(Subscript[v, a]))σ;
eΓ[α ω/sa, {(Subscript[y, a]),1}.(({{1/α, θ/α}, {-ϕ/α, (α Ξ-ϕ θ)/α}})).{(Subscript[x, a]),1},
((Subscript[v, a])/sa)+(σ/.{(Subscript[v, a])->0})]/.{(Subscript[t, a]):>1/(Subscript[t, a]),(Subscript[b, a]):>-(Subscript[b, a])}//eΓCollect];

Verifying the crossings

((Subscript[eR, 1,2]^(+))//dH[1])≡((Subscript[eR, 1,2]^(-)))
((Subscript[eR, 1,2]^(+))//dH[2])≡((Subscript[eR, 1,2]^(-)))
((Subscript[eR, 1,2]^(-))//dH[1])≡((Subscript[eR, 1,2]^(+)))
((Subscript[eR, 1,2]^(-))//dH[2])≡((Subscript[eR, 1,2]^(+)))

Verifying the stitching relations

ζ=eΓ[ω,{(Subscript[y, b]),(Subscript[y, c]),(Subscript[y, S])}.(({{α, β, θ}, {γ, δ, ϵ}, {ϕ, ψ, Ξ}})).{(Subscript[x, b]),(Subscript[x, c]),(Subscript[x, S])},(Subscript[s, b])(Subscript[v, b])+(Subscript[s, c])(Subscript[v, c])+(Subscript[s, S])(Subscript[v, S])]
(ζ//(Subscript[em, b,c->a])//dH[a])≡(ζ//dH[b]//dH[c]//(Subscript[em, c,b->a]))

Strand doubling

qΔ[i_,j_,k_][eΓ[ω_,λ_,σ_]]:=Module[
{α,θ,ϕ,Ξ,si,M,ti,μ,ν},
(({{α, θ}, {ϕ, Ξ}}))=(({{(∂_((Subscript[y, i]),(Subscript[x, i])))λ, (∂_(Subscript[y, i]))λ}, {(∂_(Subscript[x, i]))λ, λ}}))/.(Subscript[(y|x), i])->0/.(Subscript[t, i])->ti;
si=(∂_(Subscript[v, i]))σ/.(Subscript[t, i])->ti;μ=-1+ti;ν=α-si;
M=(({{((-α+ti si+(Subscript[t, j])ν)/μ), (((-1+(Subscript[t, j]))ν)/μ), (((-1+(Subscript[t, j]))θ)/μ)}, {(( (Subscript[t, j]) (-1+(Subscript[t, k]))ν)/μ), ((-si+ti α-(Subscript[t, j])ν)/μ), (((Subscript[t, j])(-1+(Subscript[t, k]))θ)/μ)}, {ϕ, ϕ, Ξ}}));
eΓ[ω/.{(Subscript[t, i])->(Subscript[t, j])(Subscript[t, k])},{(Subscript[y, j]),(Subscript[y, k]),1}.M.{(Subscript[x, j]),(Subscript[x, k]),1}/.{ti->(Subscript[t, j])(Subscript[t, k])},
(σ/.{(Subscript[v, i])->0})+((Subscript[v, j])+(Subscript[v, k]))si/.(Subscript[t, i])|ti->(Subscript[t, j])(Subscript[t, k])]//eΓCollect
];

Verifying the crossings

qΔ[1,1,2][(Subscript[eR, 1,3]^(+))]≡((Subscript[eR, 2,3]^(+))(Subscript[eR, 1,4]^(+))//(Subscript[em, 3,4->3]))
qΔ[1,1,2][(Subscript[eR, 1,3]^(-))]≡ ((Subscript[eR, 1,3]^(-))(Subscript[eR, 2,4]^(-))//(Subscript[em, 3,4->3]))
qΔ[2,2,3][(Subscript[eR, 1,2]^(+))] ≡ ((Subscript[eR, 1,2]^(+))(Subscript[eR, 4,3]^(+))//(Subscript[em, 1,4->1]))
qΔ[2,2,3][(Subscript[eR, 1,2]^(-))] ≡((Subscript[eR, 1,3]^(-))(Subscript[eR, 4,2]^(-))//(Subscript[em, 1,4->1]))

Verifying the stitching relations

ζ=eΓ[ω,{(Subscript[y, i]),(Subscript[y, j]),(Subscript[y, S])}.(({{α, β, θ}, {γ, δ, ϵ}, {ϕ, ψ, Ξ}})).{(Subscript[x, i]),(Subscript[x, j]),(Subscript[x, S])},(Subscript[s, i])(Subscript[v, i])+(Subscript[s, j])(Subscript[v, j])+(Subscript[s, S])(Subscript[v, S])]
(ζ//qΔ[i,(Subscript[i, 1]),(Subscript[i, 2])]//qΔ[j,(Subscript[j, 1]),(Subscript[j, 2])]//(Subscript[em, (Subscript[i, 1]),(Subscript[j, 1])->(Subscript[k, 1])])//(Subscript[em, (Subscript[i, 2]),(Subscript[j, 2])->(Subscript[k, 2])]))≡
(ζ//(Subscript[em, i,j->k])//qΔ[k,(Subscript[k, 1]),(Subscript[k, 2])])

3. The Lie Algebra (Subscript[G, 0])

Again first we format (Subscript[G, 0])

CF[expr_] := expr//Simplify;
𝔼 /: CF[𝔼[ω_,λ_]] := 𝔼[CF[ω], CF[λ]];
𝔼 /: 𝔼[ω1_, λ1_]𝔼[ω2_, λ2_] := CF@𝔼[ω1 ω2, λ1+λ2];
𝔼[ω1_,λ1_] ≡ 𝔼[ω2_, λ2_] := CF[ω1==ω2∧λ1==λ2];

So for instance

𝔼[ω,Sum[(Subscript[l, x,y])(Subscript[b, x])(Subscript[c, y])+(Subscript[q, x,y])(Subscript[u, x])(Subscript[w, y]),{x,{i,j}},{y,{i,j}}]]

The switching operators

(Subscript[N, (Subscript[u, i_])(Subscript[c, j_])->k_])[𝔼[ω_, λ_]] := CF[
𝔼[ω,(E^(-γ))β (Subscript[u, k])+γ (Subscript[c, k])+(λ/.(Subscript[c, j])|(Subscript[u, i])->0)]/.{γ->(∂_(Subscript[c, j]))λ,β->(∂_(Subscript[u, i]))λ}];
(Subscript[N, (Subscript[w, i_])(Subscript[c, j_])->k_])[𝔼[ω_, λ_]] := CF[
𝔼[ω, (E^γ)α (Subscript[w, k])+γ (Subscript[c, k])+(λ/.(Subscript[c, j])|(Subscript[w, i])->0)]/.{γ->(∂_(Subscript[c, j]))λ,α->(∂_(Subscript[w, i]))λ}];
(Subscript[N, (Subscript[w, i_])(Subscript[u, j_])->k_])[𝔼[ω_,λ_]] := CF[
𝔼[ν ω , -(Subscript[b, k])ν α β+ν β (Subscript[u, k])+ν δ (Subscript[u, k])(Subscript[w, k])+ν α (Subscript[w, k]) +(λ/.(Subscript[w, i])|(Subscript[u, j])->0)] /. ν-> (((1+(Subscript[b, k]) δ))^(-1)) 
/. {α->(∂_(Subscript[w, i]))λ/.(Subscript[u, j])->0, β->(∂_(Subscript[u, j]))λ/.(Subscript[w, i])->0, δ->(∂_((Subscript[w, i]),(Subscript[u, j])))λ}];

The stitching operation

(Subscript[gm, i_,j_->k_])[𝔼[ω_, λ_]] :=CF[Module[{x},
(𝔼[ω, λ] // (Subscript[N, (Subscript[w, i])(Subscript[c, j])->x])//(Subscript[N, (Subscript[u, i])(Subscript[c, x])->x])//(Subscript[N, (Subscript[w, x])(Subscript[u, j])->x])) /. {(Subscript[c, i])->(Subscript[c, k]),(Subscript[w, j])->(Subscript[w, k]),(Subscript[y_, x]):>(Subscript[y, k]),(Subscript[b, i|j])->(Subscript[b, k])}]]
(Subscript[gR, i_,j_]^(+))=𝔼[1,(Subscript[b, i])(Subscript[c, j])+(Subscript[b, i]^(-1))((E^(Subscript[b, i]))-1)(Subscript[u, i])(Subscript[w, j])]; (Subscript[gR, i_,j_]^(-))=𝔼[1,-(Subscript[b, i])(Subscript[c, j])+(Subscript[b, i]^(-1))((E^(-(Subscript[b, i])))-1)(Subscript[u, i])(Subscript[w, j])];

Next we program a map from (Subscript[G, 0]) to extended Γ-calculus.

G0toΓ[e_]:= Module[{A,λ,L,ω,Q,n,II,DD,T,M,σ,i,j},
ω=e[[1]]/. (E^(x_)):>(E^(Simplify[x /. (Subscript[b, i_]):>Log[(Subscript[t, i])]]))//Simplify;
λ = e[[2]];
A=Union@Cases[λ, (Subscript[(b|c), a_]):> a, ∞];
L = Outer[Factor[(∂_(Subscript[b, #1]))(∂_(Subscript[c, #2]))λ]&, A, A];
Q = Outer[Factor[(∂_((Subscript[u, #1]),(Subscript[w, #2])))λ]&, A, A];
n=Length[A];
II = IdentityMatrix[n];
DD=DiagonalMatrix[Table[(Subscript[b, i]),{i,A}]];
T = DiagonalMatrix[Table[Product[(Subscript[t, A[[i]]]^(L[[i,j]])),{i,1,n}],{j,1,n}]];
σ=Sum[Product[(Subscript[t, A[[i]]]^(L[[i,j]])),{i,1,n}](Subscript[v, A[[j]]]),{j,1,n}];
M = T.(II-DD.Q)/. (E^(x_)):>(E^(Simplify[x /. (Subscript[b, i_]):>Log[(Subscript[t, i])]]))//Simplify;
eΓ[(ω^(-1)),Table[(Subscript[y, i]),{i,A}].M.Table[(Subscript[x, i]),{i,A}],σ]];

Verifying the crossings

(Subscript[eR, i,j]^(+))≡((Subscript[gR, i,j]^(+))//G0toΓ)
(Subscript[eR, i,j]^(-))≡((Subscript[gR, i,j]^(-))//G0toΓ)

Verifying the stitching relations

ζ=𝔼[ω,Sum[(Subscript[l, x,y])(Subscript[b, x])(Subscript[c, y])+(Subscript[q, x,y])(Subscript[u, x])(Subscript[w, y]),{x,{i,j,S}},{y,{i,j,S}}]]
(ζ//G0toΓ//(Subscript[em, i,j->k]))≡ (ζ//(Subscript[gm, i,j->k])//G0toΓ)

Orientation reversal

gH[a_][e_𝔼]:=(e/.{(Subscript[c, a])-> -(Subscript[c, a]),(Subscript[w, a])->-(Subscript[w, a]),(Subscript[b, a])->-(Subscript[b, a]),(Subscript[u, a])->-(Subscript[u, a])})//(Subscript[N, (Subscript[u, a])(Subscript[c, a])->a])//(Subscript[N, (Subscript[w, a])(Subscript[c, a])->a])//(Subscript[N, (Subscript[w, a])(Subscript[u, a])->a])