Software for computing virtual knot invariants

Question

Do you know any software which computes invariants for a given virtual knot? I mean invariants such as: Jones Polynomial (or even Khovanov homology), etc.

Answer 1

Calculating Jones polynomials is rather straightforward. Here is some (somewhat inefficient) Mathematica code to do so: (caveat lector, this is only lightly tested)

(*Temperley-Lieb algebra*)
SetAttributes[P, Orderless];
P /: P[a_, b_] P[b_, c_] := P[a, c];
P /: P[a_, b_]^2 := P[a, a];
P /: P[a_, a_] := -(A^2 + A^-2);

(*Kauffman bracket of a "planar diagram"*)
kb[diagram_PD] := 
  FullSimplify[
   Times @@ (diagram /. {
      X[a_, b_, c_, d_] :> 
         A P[a, b] P[c, d] + A^-1 P[a, d] P[b, c]})/(-A^2 - A^-2)];

writhe[diagram_PD] := Plus @@ (diagram /. {_Xr -> 1, _Xl -> -1});

jones[diagram_PD] := 
  Collect[
    FullSimplify[
      kb[diagram /. Xr | Xl -> X]*(-A^-3)^writhe[diagram] /. A -> t^(-1/4)],
    t];

The inefficiency mostly comes from the the order in which TL elements are contracted. There is a reasonably good heuristic on the Knot Atlas you might consider for very large links. (While for classical knots there is an $O(e^{\sqrt{n}})$ approach using planar separators, this does not work for virtual knots.)

Some examples:

In[40]:= (*a right-handed trefoil*)
k31 = PD[Xr[1, 2, 5, 4], Xr[2, 3, 6, 5], Xr[3, 1, 4, 6]];
jones[k31]

Out[41]= t + t^3 - t^4

In[42]:= (* a "virtual trefoil" *)
vtref = PD[Xl[4, 2, 3, 1], Xl[1, 3, 4, 2]];
jones[vtref]

Out[43]= -(1/t^(5/2)) + 1/t^(3/2) + 1/t

This is using the following convention for oriented planar diagrams:

An edge is a portion of a link between a pair of crossings. Each edge is given a unique identifier/number. Then, a PD is a list of Xr and Xl with the incident edge numbers. (I'm not sure if this is a standard, though I like how replacing Xr and Xl with X gives the underlying unoriented link.)