Pensieve header: A race between the slow Jones program and the fast Jones program.

<< KnotTheory`

J[K_] := Module[{t1,t2,t3,t4,t5,t6,P},
SetAttributes[P, Orderless];
t1=PD[K] /. x_X :> If[PositiveQ[x], Xp@@x, Xm@@x];
t2=Times@@t1;
t3=t2 /. {
Xp[i_,j_,k_,l_] :> q*P[i,j]P[k,l]-q^2*P[i,l]P[j,k],
Xm[i_,j_,k_,l_] :> -q^(-2)*P[i,j]P[k,l]+1/q*P[i,l]P[j,k]
};
t4=Expand[t3];
t5=t4 //. P[a_,b_]P[b_,c_] :> P[a,c];
t6=t5 /. {
P[i_,i_] :> (q+1/q),
P[i_,j_]^2 :> (q+1/q)
};
Simplify[(t6/(q+(q^(-1)))) /. q->(Sqrt[q])]
]

FJ[K_] := Module[{todo,touched={},x,J=1},
SetAttributes[P, Orderless];
todo=List@@PD[K] /. x_X :> If[PositiveQ[x], Xp@@x, Xm@@x];
While[Length[todo]>0,
x=First@MaximalBy[todo,Length[touched⋂(List@@#)]&];
J*=x /. {
Xp[i_,j_,k_,l_] :> q*P[i,j]P[k,l]-q^2*P[i,l]P[j,k],
Xm[i_,j_,k_,l_] :> -q^(-2)*P[i,j]P[k,l]+1/q*P[i,l]P[j,k]
};
J=Expand[J]//. P[a_,b_]P[b_,c_] :> P[a,c] /. {
P[i_,i_] :> (q+1/q),
P[i_,j_]^2 :> (q+1/q)
};
todo=DeleteCases[todo, x];
];
Simplify[(J/(q+(q^(-1)))) /. q->(Sqrt[q])]
]

LaunchKernels[];
DistributeDefinitions/@ {"KnotTheory`", "Global`"}

WaitAll[{
ParallelSubmit[
t0=TimeUsed[];
Do[
{t1,J1}=Timing@J[K];
Print["Slow Jones: ",{K,Length@PD[K],TimeUsed[]-t0,t1, J1}],
{K, TorusKnots[100]}
]
],
ParallelSubmit[
t0=TimeUsed[];
Do[
{t1,J1}=Timing@FJ[K];
Print["Fast Jones: ",{K,Length@PD[K],TimeUsed[]-t0, t1, J1}],
{K, TorusKnots[100]}
]
]
}]