Pensieve header: Compute and store ρ, Kh, and HOMFLYPT for knots with up to 14 crossings

SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\APerturbedAlexanderInvariant"];

Once[<<KnotTheory`; <<RVK.m];

ρ[K_]:=ρ[K]=Module[{Cs,r,n,B,A,c,s,i,j,Δ,G,g,ρ1},
{Cs,r}=List@@RVK[K]; n=Length[Cs]; B=Table[0,2n,2n+1];
Do[{s,i,j}=c;B[[{i,j},{i,j,i+1,j+1}]]=(({{1, 0, -1, 0}, {0, 1, (T^s)-1, -(T^s)}})),{c,Cs}];
A=B[[All,2;;]];
Δ=(T^((Total[r]-Total[First/@Cs])/2))Det[A];
G=Prepend[Table[0,2n]][Inverse[A]]; (Subscript[g, α_,β_]):=G[[α,β]];
ρ1=(Δ^2)Sum[{s,i,j}=c;s((1-(T^s))(Subscript[g, i,j])((Subscript[g, i,j])-(Subscript[g, j,j]))+2(Subscript[g, i,i])(Subscript[g, i,j])-(Subscript[g, i,j])(Subscript[g, j,i])-(Subscript[g, i,i])(Subscript[g, j,j])-(Subscript[g, i,j])+(Subscript[g, j,j])-1/2),{c,Cs}];
ρ1+=(Δ^2)Sum[r[[k]]((Subscript[g, k,k])-1/2),{k,2n}] ;
Factor@{Δ,ρ1}];

Do[Echo[K->ρ[K]], {K,AllKnots[{3,6}]}]

Timing[Length@Union[ρ/@AllKnots[{3,10}]]]

Timing[Length@Union[{Kh[PD@#][q,t],HOMFLYPT[PD@#][a,z]}&/@AllKnots[{3,10}]]]

Length[AllKnots[{3,13}]]

Monitor[Timing[Tallyρ13=Tally[Last/@Tally@Table[ρ[K],{K,AllKnots[{3,13}]}]]], K]

Total[Times@@@Rest[Tallyρ13]]

Monitor[Timing[TallyHKh13=Tally[Last/@Tally@Table[{Kh[PD@K][q,t],HOMFLYPT[PD@K][a,z]},{K,AllKnots[{3,13}]}]]], K]

Total[Times@@@Rest[TallyHKh13]]

{NumberOfKnots[14],NumberOfKnots[14,Alternating],NumberOfKnots[14,NonAlternating]}

Monitor[Timing[Tallyρ14=Tally[Last/@Tally@Table[ρ[K],{K,AllKnots[{3,14}]}]]], K]

Monitor[Timing[TallyHKh14=Tally[Last/@Tally@Table[{Kh[PD@K][q,t],HOMFLYPT[PD@K][a,z]},{K,AllKnots[{3,14}]}]]], K]

{Total[Times@@@Rest[Tallyρ14]], Total[Times@@@Rest[TallyHKh14]]}

Table[K->ρ[K],{K,AllKnots[{3,14}]}] >> "Data/Rho3-14.m"

Monitor[Table[K->Kh[PD@K][q,t],{K,AllKnots[{3,14}]}] >> "Data/Kh3-14.m", K]

Monitor[Table[K->HOMFLYPT[PD@K][a,z],{K,AllKnots[{3,14}]}] >> "Data/HOMFLYPT3-14.m", K]