The Penultimate Alexander Polynomial

September 2008, Joint with Jana Archibald

Print[prog=Import[
"http://www.math.toronto.edu/~drorbn/Talks/Sandbjerg-0810/pA.m",
"Text"
]];
ToExpression[prog]

Some Relations

Reidemeister 3

res1 = pA /@ {
CircuitDiagram[Xp[7,9,6,1], Xp[3,8,7,2], Xp[8,4,5,9]],
CircuitDiagram[Xp[3,4,7,9], Xp[7,5,6,8], Xp[2,9,8,1]]
}

Equal @@ res1

Overcrossings Commute

Equal[
pA[CircuitDiagram[Xp[1,7,4,6], Xp[2,3,5,7]]],
pA[CircuitDiagram[Xp[2,7,5,6], Xp[1,3,4,7]]] ]

Commutators Commute

Equal[
pA[CircuitDiagram[Xp[1,2,11,8], Xm[11,3,12,7], Xp[12,4,13,10], Xm[13,5,6,9]], t[2]==t[3], t[4]==t[5]],
pA[CircuitDiagram[Xp[1,4,11,10], Xm[11,5,12,9], Xp[12,2,13,8], Xm[13,3,6,7]], t[2]==t[3], t[4]==t[5]] ]

res2 = pA[#, t[2]==t[3], t[4]==t[5]]&  /@ {
CircuitDiagram[Xp[1,2,11,8], Xm[11,3,12,7], Xp[12,4,13,10], Xm[13,5,6,9]],
CircuitDiagram[Xp[1,4,11,10], Xm[11,5,12,9], Xp[12,2,13,8], Xm[13,3,6,7]]
}

{1,-1}.(Last /@ res2)

Just for fun, let' s try that again with all crossings flipped :

VDDFlipped = {
CircuitDiagram[Xp[1,2,11,8], Xm[11,3,12,7], Xp[12,4,13,10], Xm[13,5,6,9]],
CircuitDiagram[Xp[1,4,11,10], Xm[11,5,12,9], Xp[12,2,13,8], Xm[13,3,6,7]]
} /. {Xp[i_,j_,k_,l_] :> Xm[l,i,j,k], Xm[i_,j_,k_,l_] :> Xp[j,k,l,i]}

res3 = (pA /@ VDDFlipped);
{1,-1}.(Last /@ res3) /. {t[5]->t[4], t[3]->t[2]}

Double Delta

Timing[res4 = pA[#, (t[1]==t[6])(t[11]==t[16])(t[21]==t[26])]& /@ {
CircuitDiagram[
Xm[19,1,20,2],Xp[11,3,12,2], Xp[3,30,4,29], Xm[4,21,5,22],
Xp[6,23,7,22], Xm[7,28,8,29], Xm[12,8,13,9], Xp[18,10,19,9],
Xm[27,13,28,14], Xp[23,15,24,14], Xm[24,16,25,17], Xp[26,18,27,17]
],
CircuitDiagram[
Xp[1,28,2,27], Xm[2,23,3,24], Xm[17,3,18,4], Xp[13,5,14,4],
Xm[14,6,15,7], Xp[16,8,17,7], Xp[8,25,9,24], Xm[9,26,10,27],
Xm[29,11,30,12], Xp[21,13,22,12], Xm[22,18,23,19], Xp[28,20,29,19]
]
}]

Equal @@ (Last /@ res4)

TimeUsed[]