© | << < ? > >> | Dror Bar-Natan: Talks:

The Penultimate Alexander Invariant

Sandbjerg, October 2008

Abstract. Following joint work with Jana Archibald I will describe a clean and elegant extension pA of the multi-variable Alexander polynomial (MVA) to the planar algebra of tangles, which is well-behaved under arbitrary planar compositions. (Actually, it's more: I really mean virtual tangles, and arbitrary circuit algebra compositions). We have at least two reasons to be happy:
  1. pA can be implemented in less than one page of computer code. After that, the proofs of many identities satisfied by the MVA, whose current proofs span many journal pages, become completely mechanical.
  2. We find at least one new identity satisfied by the MVA, which may lead to a very simple characterization of the MVA.
  3. In the case of Khovanov homology, the extension to tangles leads to significant computational and other advantages. The presence of an MVA for virtual tangles with good composition properties sets the bar for our hopes for a (or the) categorification of the MVA.

Why "penultimate"? Because there is in the works an "ultimate" Alexander invariant which is even better (though likely less elegant). But we won't talk about it here.

Handout. JavaScript browser, PDF, PNG.

Source Files. pAHandout.zip.


The Program
(also available as pA.m and pA.nb)
In[1]:=
        (* WP: Wedge Product *)
WSort[expr_] := Expand[expr /. w_W :> Signature[w]*Sort[w]];
WP[0, _] = WP[_, 0] = 0;
WP[a_, b_] := WSort[Distribute[a ** b] /.
    (c1_. * w1_W) ** (c2_. * w2_W) :> c1 c2 Join[w1, w2]];

        (* IM: Interior Multiplication *)
IM[{}, expr_] := expr;
IM[i_, w_W] := If[FreeQ[w, i], 0,
    -(-1)^Position[w, i][[1,1]]*DeleteCases[w, i] ];
IM[{is___, i_}, w_W] := IM[{is}, IM[i, w]];
IM[is_List, expr_] := expr /. w_W :> IM[is, w]

        (* pA on Crossings *)
pA[Xp[i_,j_,k_,l_]] := AHD[(t[i]==t[k])(t[j]==t[l]), {i,l}, W[j,k],
    W[l,i] + (t[i]-1)W[l,j] - t[l]W[l,k] + W[i,j] + t[l]W[j,k] ];
pA[Xm[i_,j_,k_,l_]] := AHD[(t[i]==t[k])(t[j]==t[l]), {i,j}, W[k,l],
    t[j]W[i,j] - t[j]W[i,l] + W[j,k] + (t[i]-1)W[j,l] + W[k,l] ]

        (* Variable Equivalences *)
ReductionRules[Times[]] = {};
ReductionRules[Equal[a_, b__]] := (# -> a)& /@ {b}; 
ReductionRules[eqs_Times] := Join @@ (ReductionRules /@ List@@eqs)

        (* AHD: Alexander Half Densities *)
AHD[eqs_, is_, -os_, p_] := AHD[eqs, is, os, Expand[-p]];
AHD /: Reduce[AHD[eqs_, is_, os_, p_]] := 
  AHD[eqs, Sort[is], WSort[os], WSort[p /. ReductionRules[eqs]]];
AHD /: AHD[eqs1_,is1_,os1_,p1_] AHD[eqs2_,is2_,os2_,p2_] := Module[
  {glued = Intersection[Union[is1, is2], List@@Union[os1, os2]]}, 
  Reduce[AHD[
    eqs1*eqs2 //. eq1_Equal*eq2_Equal /; 
      Intersection[List@@eq1, List@@eq2] =!= {} :> Union[eq1, eq2],
    Complement[Union[is1, is2], glued],
    IM[glued, WP[os1, os2]],
    IM[glued, WP[p1, p2]]
]] ]

        (* pA on Circuit Diagrams *)
pA[cd_CircuitDiagram, eqs___] := pA[cd, {}, AHD[Times[eqs], {}, W[], W[]]];
pA[cd_CircuitDiagram, done_, ahd_AHD] := Module[
  {pos = First[Ordering[Length[Complement[List @@ #, done]] & /@ cd]]},
  pA[Delete[cd, pos], Union[done, List @@ cd[[pos]]], ahd*pA[cd[[pos]]]]
];
pA[CircuitDiagram[], _, ahd_AHD] := ahd
Reidemeister 3
In[2]:=
pA[CircuitDiagram[Xp[7, 9, 6, 1], Xp[3, 8, 7, 2], Xp[8, 4, 5, 9]]] == 
 pA[CircuitDiagram[Xp[3, 4, 7, 9], Xp[7, 5, 6, 8], Xp[2, 9, 8, 1]]]
Out[2]=
True