Pensieve header: A talk and a program about Archibald- and $\Gamma$-calculus and the Halacheva map between them. Continues pensieve://2021-02/, continued pensieve://Talks/MoscowByWeb-2104/.

Title. I Still don’t Understand the Alexander Polynomial

Abstract. As an algebraic knot theorist, I still don’t understand the Alexander polynomial. There are two conventions as for how to present tangle theory in algebra: one may name the strands of a tangle, or one may name their ends. The distinction might seem too minor to matter, yet it leads to a completely different view of the set of tangles as an algebraic structure. There are lovely formulas for the Alexander polynomial as viewed from either perspective, and they even agree where they meet. But the “strands” formulas know about strand doubling while the “ends” ones don’t, and the “ends” formulas know about skein relations while the “strands” ones don’t. There ought to be a common generalization, but I don’t know what it is.

General

(Subscript[Xp, a_,b_]):= Xp[a,b]; (Subscript[Xm, a_,b_]):=Xm[a,b];

SXForm[L_] := SXForm[
Skeleton[L],
Times@@PD[L] /. X[i_,j_,k_,l_] :> If[PositiveQ[X[i,j,k,l]],Xp[l,i], Xm[j,i]]
];
Z[L_] := Z[Identity, L];
Z[χ_, L_] := Module[{s, z},
{s, z} = List @@ SXForm[L];
z=χ[z];
Do[z = z // dm[s[[c,1]],s[[c,k]] ,s[[c,1]]], {c, Length[s]},{k, 2, Length[s[[c]]]}];
z
];

dA[a_,rest__][α_] := α // dA[a] // dA[rest];
dA[l_List] := dA @@ l;
dA[All][α_] := α//dA[dL[α]];
dS[a_,rest__][α_] := α // dS[a] // dS[rest];
dS[l_List] := dS @@ l;
dS[All][α_] := α//dS[dL[α]];

Γ-Calculus

ΓSimp=Factor; SetAttributes[ΓCollect, Listable];
ΓCollect[Γ[ω_,σ_,λ_]] := ΓCollect[ΓSimp][Γ[ω,σ,λ]];
ΓCollect[simp_][Γ[ω_,σ_,λ_]] := Γ[simp[ω], simp[σ],
Collect[λ, (Subscript[h, _]), Collect[#,(Subscript[t, _]), simp]&]];
dL[Γ[_,_,λ_]] := Union[Cases[λ, (Subscript[(h|t), a_]) :> a, Infinity]];
Γ[ω1_,_, _][ω] := ω1;
Γ[ω_,σ_,λ_][Σ] := ((∂_(Subscript[h, #]))σ)& /@ dL[Γ[ω,σ,λ]];
Γ[ω_,σ_,λ_][A] := Module[{S=dL[Γ[ω,σ,λ]]}, Outer[ΓSimp[((∂_((Subscript[t, #1]),(Subscript[h, #2])))λ)]&, S, S]];
ΓForm[Γ[ω_,σ_,λ_]] := Module[{S, M},
S = dL[Γ[ω,σ,λ]];
M = Γ[ω,σ,λ][A] // Transpose;
PrependTo[M, (Subscript[s, #])& /@ S];
M = Join[
{Prepend[(Subscript[s, #])& /@ S, ω]},
Transpose[M],
{Prepend[Γ[ω,σ,λ][Σ], "Γ"]}
];
MatrixForm[M]
];
ΓForm[else_] := else /. Γ[ω_,σ_,λ_] :> ΓForm[Γ[ω,σ,λ]];
Format[Γ[ω_,σ_,λ_], StandardForm] := ΓForm[Γ[ω,σ,λ]];

Γ /: Γ[ω1_,σ1_, μ1_] == Γ[ω2_,σ2_, μ2_] := Module[
{S},
S=dL[Γ[ω1,σ1, μ1]]⋃dL[Γ[ω2,σ2, μ2]];
(ω1 == ω2) && (And @@ (((∂_(Subscript[h, #]))σ1 == (∂_(Subscript[h, #]))σ2)& /@ S)) && (
And @@ Flatten[Outer[
((∂_((Subscript[t, #1]),(Subscript[h, #2])))μ1== (∂_((Subscript[t, #1]),(Subscript[h, #2])))μ2)&,
S,S
]]
)
]

Γ /: Γ[ω1_,σ1_,λ1_]Γ[ω2_,σ2_,λ2_] := Γ[ω1*ω2, σ1+σ2, λ1+λ2];
(Subscript[dm, i_,j_->k_])[Γ[ω_,σ_,λ_]] := Module[{α,β,γ,δ,θ,ϵ,ϕ,ψ,Ξ,μ},
(({{α, β, θ}, {γ, δ, ϵ}, {ϕ, ψ, Ξ}}))=(({{(∂_((Subscript[t, i]),(Subscript[h, i])))λ, (∂_((Subscript[t, i]),(Subscript[h, j])))λ, (∂_(Subscript[t, i]))λ}, {(∂_((Subscript[t, j]),(Subscript[h, i])))λ, (∂_((Subscript[t, j]),(Subscript[h, j])))λ, (∂_(Subscript[t, j]))λ}, {(∂_(Subscript[h, i]))λ, (∂_(Subscript[h, j]))λ, λ}}))/.(Subscript[(t|h), i|j])->0;
ΓCollect[Γ[(μ=1-β)ω,
(Subscript[h, k])((∂_(Subscript[h, i]))σ)((∂_(Subscript[h, j]))σ)+(σ /. (Subscript[h, i|j])->0),
{(Subscript[t, k]),1}.(({{γ+α δ/μ, ϵ+δ θ/μ}, {ϕ+α ψ/μ, Ξ+θ ψ/μ}})).{(Subscript[h, k]),1}
]] /. {(Subscript[T, i])->(Subscript[T, k]), (Subscript[T, j])->(Subscript[T, k]),(Subscript[b, i])->(Subscript[b, k]), (Subscript[b, j])->(Subscript[b, k])} // ΓCollect
];
dm[a_,b_,c_][Γ[ω_,σ_,λ_]]  := (Subscript[dm, a,b->c])[Γ[ω,σ,λ]];
dη[a_][γ_Γ] := γ /. {(Subscript[(h|t), a]) -> 0, (Subscript[T, a])->1};

tr[a_][Γ[ω_,σ_, λ_]] := Module[{α,θ,ψ,Ξ},
(({{α, θ}, {ψ, Ξ}}))=(({{(∂_((Subscript[t, a]),(Subscript[h, a])))λ, (∂_(Subscript[t, a]))λ}, {(∂_(Subscript[h, a]))λ, λ}}))/.(Subscript[(t|h), a])->0;
Γ[ω(1-α),σ /. (Subscript[h, a])->0,Ξ+ψ*θ/(1-α)]// ΓCollect];

FullStitch[γ1_Γ,γ2_Γ] := Module[{S1,S2,S, γ,τ},
S=(S1=dL[γ1])⋃(S2=dL[γ2]);
γ=γ1(Times@@(Γ/@ϵ/@Complement[S,S1]));
γ*=(γ2 /. {(Subscript[h, a_]):>(Subscript[h, τ[a]]), (Subscript[t, a_]):>(Subscript[t, τ[a]]), (Subscript[T, a_]):>(Subscript[T, τ[a]])})(Times@@(Γ/@ϵ/@τ/@Complement[S,S2]));
Do[
γ=γ//dm[s,τ[s],s],
{s,S}
];
γ
];
Γ /: γ1_Γ**γ2_Γ := Module[{S1,S2,S, γ1p,γ2p},
S=(S1=dL[γ1])⋃(S2=dL[γ2]);
γ1p=γ1(Times@@(Γ/@ϵ/@Complement[S,S1]));
γ2p=γ2(Times@@(Γ/@ϵ/@Complement[S,S2]));
Γ[
γ1p[ω]*γ2p[ω],
(γ1p[Σ]γ2p[Σ]).((Subscript[h, #])& /@ S),
((Subscript[t, #])& /@ S).(γ2p[A].γ1p[A]).((Subscript[h, #])& /@ S)
]
];

Γ /: ((Γ[ω_,σ_,λ_])^(-1)) := Module[{S=dL[Γ[ω,σ,λ]]},
Γ[
(ω^(-1)), Collect[σ, (Subscript[h, _]), (1/#)&],
((Subscript[t, #])& /@ S).Inverse[ Outer[ΓSimp[((∂_((Subscript[t, #1]),(Subscript[h, #2])))λ)]&, S, S]].((Subscript[h, #])& /@ S)
]
];

dA[a_][Γ[ω_,σ_,λ_]] := Module[
{α, θ, ϕ, Ξ, σa},
(({{α, θ}, {ϕ, Ξ}}))=(({{(∂_((Subscript[t, a]),(Subscript[h, a])))λ, (∂_(Subscript[t, a]))λ}, {(∂_(Subscript[h, a]))λ, λ}})) /. (Subscript[(h|t), a])->0;
σa=(∂_(Subscript[h, a]))σ;
ΓCollect[Γ[
α ω/σa,
((σ/.(Subscript[h, a])->0)+(Subscript[h, a])/σa),
{(Subscript[t, a]), 1}.(({{1, θ}, {-ϕ, α Ξ-ϕ θ}})).{(Subscript[h, a]),1}/α
]]
];
dS[a_][γ_Γ] := ΓCollect[dA[a][γ] /. {(Subscript[T, a])->1/(Subscript[T, a]), (Subscript[b, a])->-(Subscript[b, a])}];

Mirror[γ_Γ] := Module[{γ1},
γ1 = γ // (dS@@dL[γ]);
γ1[[3]] = γ1[[3]] /. {(Subscript[t, a_]):>(Subscript[h, a]), (Subscript[h, a_]):>(Subscript[t, a])};
γ1];

tσ[rules___Rule][γ_Γ] := ΓCollect[
γ /. {(Subscript[t, u_]) :> (Subscript[t, u /. {rules}]), (Subscript[T, u_]) :> (Subscript[T, u /. {rules}]), (Subscript[b, u_]) :> (Subscript[b, u /. {rules}])}
];
hσ[rules___Rule][γ_Γ] := ΓCollect[γ /. (Subscript[h, x_]) :> (Subscript[h, x /. {rules}])];

SetAttributes[Γ, Listable];
Γ[p_Times|p_NonCommutativeMultiply]:= Γ /@ p;
Γ[ϵ[a_]] := Γ[1,(Subscript[h, a]), (Subscript[h, a])(Subscript[t, a])];
Γ[Xp[a_,b_]] :=Γ[1, (Subscript[h, a])+(Subscript[h, b])(Subscript[T, a]), {(Subscript[t, a]),(Subscript[t, b])}.(({{1, 1-(Subscript[T, a])}, {0, (Subscript[T, a])}})).{(Subscript[h, a]),(Subscript[h, b])}];
Γ[Xm[a_,b_]] := Γ[Xp[a,b]] /. (Subscript[T, a])->1/(Subscript[T, a]);

MVA[Γ, L_Link] := Module[{Hs,ω,σ,μ,A},
{ω,σ,μ} = List @@ Z[Γ, L];
Hs = Rest[(Subscript[h, #])& /@ (First /@ Skeleton[L])];
A=Outer[Coefficient[μ, #1*#2]&,Hs, Hs /. (Subscript[h, a_]) :> (Subscript[t, a])];
Factor[((ω Det[A-IdentityMatrix@Length@Hs])/(1-(Subscript[T, Skeleton[L][[1,1]]])))]
]

𝒜-Calculus

WP[Wedge[u___],Wedge[v___]]:=Signature[{u,v}]*Wedge@@Sort[{u,v}];
WP[0,_]=WP[_,0]=0;
WP[A_,B_]:=Expand[Distribute[A ** B] /. (a_. * u_Wedge) ** (b_. * v_Wedge):>a b WP[u,v]];

WExp[A_]:=Module[{s=Wedge[],t=Wedge[],k=0},
While[t=!=0,s+=(t=Expand[WP[t,A]/(++k)])]; s]

(Subscript[c, x_,y_])[w_Wedge]:=Module[{i,j},
{i}=FirstPosition[w,x,{0}]; {j}=FirstPosition[w,y,{0}];
Which[
(i==0)∧(j==0), w,
(i==0)∨(j==0), 0,
True,(((-1))^(i+j+If[i>j,1,0]))Delete[w,{{i},{j}}]
]];
(Subscript[c, x_,y_])[ℰ_]:=ℰ/.w_Wedge:>(Subscript[c, x,y])[w]

𝒜[Γ[ω_,_,λ_]]:=Expand[ω WExp[Expand[λ]/.(Subscript[t, a_])(Subscript[h, b_]):>(Subscript[ξ, a])⋀(Subscript[x, b])]]

𝒜[(Subscript[X, i_,j_,k_,l_])[u_,o_]]:=𝒜[{i,l},{j,k},<|(Subscript[ξ, i])->u,(Subscript[x, j])->o,(Subscript[x, k])->u,(Subscript[ξ, l])->o|>,WExp[-o (Subscript[ξ, i])⋀(Subscript[x, k])-(Subscript[ξ, l])⋀(Subscript[x, j])-(Subscript[ξ, l])⋀(Subscript[x, k])+o (Subscript[ξ, l])⋀(Subscript[x, k])]];
𝒜[(Subscript[(OverBar[X]), i_,j_,k_,l_])[u_,o_]]:=𝒜[{i,j},{k,l},<|(Subscript[ξ, i])->u,(Subscript[ξ, j])->o,(Subscript[x, k])->u,(Subscript[x, l])->o|>,WExp[-(o^(-1))(Subscript[ξ, i])⋀(Subscript[x, k])-(Subscript[ξ, j])⋀(Subscript[x, k])+(o^(-1))(Subscript[ξ, j])⋀(Subscript[x, k])-(Subscript[ξ, j])⋀(Subscript[x, l])]];
𝒜[(Subscript[X, i_,j_,k_,l_])]:=𝒜[(Subscript[X, i,j,k,l])[(Subscript[\[FormalCapitalT], i]),(Subscript[\[FormalCapitalT], l])]];
𝒜[(Subscript[(OverBar[X]), i_,j_,k_,l_])]:=𝒜[(Subscript[(OverBar[X]), i,j,k,l])[(Subscript[\[FormalCapitalT], i]),(Subscript[\[FormalCapitalT], j])]];

𝒜/:𝒜[is1_,os1_,cs1_,w1_]𝒜[is2_,os2_,cs2_,w2_]:=𝒜[is1⋃is2,os1⋃os2,Join[cs1,cs2],WP[w1,w2]]

(Subscript[c, h_,t_])@𝒜[is_,os_,cs_,w_]:=𝒜[
DeleteCases[is,t],DeleteCases[os,h],KeyDrop[cs,{(Subscript[x, h]),(Subscript[ξ, t])}],(Subscript[c, (Subscript[x, h]),(Subscript[ξ, t])])[w]
] /. If[cs[(Subscript[ξ, t])][[1]]===\[FormalCapitalT], cs[(Subscript[ξ, t])]->cs[(Subscript[x, h])],cs[(Subscript[x, h])]-> cs[(Subscript[ξ, t])]];
c@𝒜[is_,os_,cs_,w_]:=Fold[(Subscript[c, #2,#2])[#1]&,𝒜[is,os,cs,w],is⋂os]

WP[Wedge[x],Wedge[y]]

WP[Wedge[y],Wedge[x]]

A=Sum[(Subscript[a, i])((Subscript[x, i])⋀(Subscript[y, i])),{i,2}]

t=Wedge[]

WP[t,A]

WExp[Sum[(Subscript[a, i])((Subscript[x, i])⋀(Subscript[y, i])),{i,4}]]

(Subscript[c, (Subscript[x, 6]),(Subscript[x, 5])])[(Subscript[x, 1])⋀(Subscript[x, 2])⋀(Subscript[x, 3])⋀(Subscript[x, 4])]

lhs=(Subscript[c, (Subscript[x, 4]),(Subscript[y, 4])])[WExp[Sum[(Subscript[a, i])((Subscript[x, i])⋀(Subscript[y, i])),{i,4}]]]

rhs=Expand[(1-(Subscript[a, 4]))WExp[Sum[(Subscript[a, i])((Subscript[x, i])⋀(Subscript[y, i])),{i,3}]]]

lhs==rhs

lhs=(Subscript[c, (Subscript[x, 3]),(Subscript[y, 3])])[(Subscript[c, (Subscript[x, 4]),(Subscript[y, 4])])[WExp[Sum[(Subscript[a, i])((Subscript[x, i])⋀(Subscript[y, i])),{i,4}]]]]

n=4; γ0=Γ[ω, (∑_(a=1)^n)(Subscript[h, a])(Subscript[σ, a]), (∑_(a=1)^n)(∑_(b=1)^n)(Subscript[t, a])(Subscript[h, b])(Subscript[α, 10a+b])]
γ0 // tr[2]

lhs=𝒜[γ0//tr[1]]//Simplify

rhs=(Subscript[c, (Subscript[ξ, 1]),(Subscript[x, 1])])[𝒜[γ0]]//Simplify

Simplify[lhs==rhs]

Import[
"C:\\drorbn\\AcademicPensieve\\Talks\\Sandbjerg-0810/pA.txt",
"Text"
]

Expand[((Subscript[Xp, a,b])//Γ)[[3]]]

Expand[((Subscript[Xp, a,b])//Γ)[[3]]]/.(Subscript[t, a_])(Subscript[h, b_]):>-((Subscript[ξ, a])⋀(Subscript[x, b]))/.{(Subscript[ξ, a])->(Subscript[ξ, l]),(Subscript[ξ, b])->(Subscript[ξ, i]),(Subscript[x, a])->(Subscript[x, j]),(Subscript[x, b])->(Subscript[x, k]),(Subscript[T, a])->o}

Expand[((Subscript[Xm, a,b])//Γ)[[3]]]/.(Subscript[t, a_])(Subscript[h, b_]):>-((Subscript[ξ, a])⋀(Subscript[x, b]))/.{(Subscript[ξ, a])->(Subscript[ξ, j]),(Subscript[ξ, b])->(Subscript[ξ, i]),(Subscript[x, a])->(Subscript[x, l]),(Subscript[x, b])->(Subscript[x, k]),(Subscript[T, a])->o}

The 𝒜-invariants of the crossings.

𝒜[(Subscript[X, i,j,k,l])]

𝒜[(Subscript[(OverBar[X]), i,j,k,l])]

𝒜[(Subscript[X, 2,5,4,1])]𝒜[(Subscript[X, 3,7,6,5])]𝒜[(Subscript[X, 6,9,8,4])] // Short

𝒜[(Subscript[X, 2,5,4,1])]𝒜[(Subscript[X, 3,7,6,5])]

(Subscript[c, 4,1])[𝒜[(Subscript[X, 2,5,4,1])]𝒜[(Subscript[X, 3,7,6,5])]]

c[𝒜[(Subscript[X, 2,5,4,1])]𝒜[(Subscript[X, 3,7,6,5])]]

lhs=c[𝒜[(Subscript[X, 2,5,4,1])]𝒜[(Subscript[X, 3,7,6,5])]𝒜[(Subscript[X, 6,9,8,4])]]

rhs=c[𝒜[(Subscript[X, 3,5,4,2])]𝒜[(Subscript[X, 4,6,8,1])]𝒜[(Subscript[X, 5,7,9,6])]]

lhs[[4]]==rhs[[4]]

c[𝒜[(Subscript[X, 2,4,3,1])]𝒜[(Subscript[(OverBar[X]), 3,4,6,5])]]