Pensieve header: Drawing the Willerton Fish on April 6, 2016.

The Willerton Fish

Willerton: It is amuzing to plot the values of (Subscript[v, 2]) against the values of (Subscript[v, 3]) on a large sample of knots.

<< KnotTheory`

GD[K_] := GD@@PD[K] /. X[i_,j_,k_,l_] :> If[PositiveQ[X[i,j,k,l]],Ap[l,i], Am[j,i]];
Column[GD /@ AllKnots[{3,6}]]

Draw[gd_GD] := Module[{n=Length@gd},Graphics[{
Line[{{0,0}, {2n+1,0}}],
List@@gd /. (ah_)[i_,j_] :> {
Arrow[BezierCurve[{{i,0}, 0.5{i+j,Abs[j-i]}, {j,0}}]],
Text[ah /. {Ap->"+", Am->"-"},{j,0.3}]},
Table[Text[i, {i,-0.5}], {i,2n}]
}]]

Draw /@ GD /@ AllKnots[{3,5}]

From Polyak-Viro’s “Gauss Diagram Formulas for Vassiliev Invariants”, IMRN 11 (1994) 445-453:

GD /: Normalize[gd_GD]:= SortBy[
gd /. Thread[Union@@(List@@@gd)->Range[2Length[gd]]],
(List@@#)&
];
GPV[F_GD, K_GD] /; Length[F]>Length[K] := 0;
GPV[F_GD, K_GD] /; Length[F]<Length[K] := Total[
GPV[F, #]& /@ Subsets[K, {Length[F]}]
];
GPV[F_GD, K_GD] /; Length[F]==Length[K] := If[
F=!=Normalize[K /. Ap|Am -> A], 0, (-1)^Count[K, _Am]
];
V2[K_] := V2[K] = GPV[GD[A[2,4],A[3,1]], GD[K]];

V2 /@ AllKnots[{3,8}]

From Polyak-Viro’s “Gauss Diagram Formulas for Vassiliev Invariants”, IMRN 11 (1994) 445-453:

GPV[F_Plus, K_] := GPV[#,K]& /@ F;
GPV[c_*F_GD, K_] := c GPV[F,K];
GPV[0,K_] = 0;
GD /: RotateLeft[gd_GD, k_Integer] := Normalize[
gd /. i_Integer :> Mod[i-k,2Length@gd,1]
];
V3Ds=Expand[Plus[
(1/2)Sum[RotateLeft[GD[A[1,5],A[4,2],A[6,3]], k], {k,0,5}],
Sum[RotateLeft[GD[A[1,4],A[5,2],A[3,6]], k], {k,0,1}]
]];
V3[K_] := V3[K] = GPV[V3Ds, GD@K];

V3 /@ AllKnots[{3,8}]

Ks=AllKnots[{3,8}]; Ks=Ks⋃(Mirror /@ Ks);
ListPlot[{V2[#], V3[#]}& /@ Ks, PlotStyle->{Red}, Axes -> False, PlotRange -> All]

Ks=AllKnots[{3,10}]; Ks=Ks⋃(Mirror /@ Ks);
Histogram3D[{V2[#], V3[#]}& /@ Ks,{1},ChartElements->Graphics3D[Cylinder[]]]