ClearAll["Global`*"];​​SetSystemOptions["ReduceOptions"->"MaxModularPoints"->10^7];​​​​(*1.statingfield&simplecticform*)​​n=3;(*workoverZ_3*)​​J={{0,1},{-1,0}};(*standardsymplecticmatrix*)​​M=Mod[2J,n];(*J'=2Jmod3={{0,2},{1,0}}*)​​computeEnhanced=True;(*setFalseifyouonlywantcounting*)​​​​(*2.variables:v1..v4are2DvectorsoverZ_n*)​​vars=Array[Subscript[x,##]&,{4,2}];​​{v1,v2,v3,v4}=vars;​​​​(*3.quandlerelationsforconnectedsumoftwoHopflinks*)​​e1=v1+(v1.M.v3)v3;​​e2=v3+(v3.M.v1)v1;​​e3=v2+(v2.M.v4)v4;​​e4=v4+(v4.M.v3)v3;​​relations=Thread[{v1,v2,v3,v4}=={e1,e2,e3,e4}];​​​​(*4.solvemodulon*)​​{tSolve,soln}=AbsoluteTiming[Solve[relations,Flatten[vars],Modulus->n]];​​count=Length[soln];​​Print["Solve time (s): ",NumberForm[tSolve,{6,3}]];​​Print["|Hom(Q(H), M)| = ",count];​​​​(*5.verification:eachrelationevaluatesto0(modn)*)​​residuals={v1-e1,v2-e2,v3-e3,v4-e4};​​chk=Mod[residuals/.soln,n];(*listof4two-vectorspersolution*)​​okQ=AllTrue[Flatten@chk,#==0&];​​If[okQ,Print["OK: all relations satisfied modulo ",n,"."],(badIdx=Flatten@Position[Map[AllTrue[Flatten@#,#==0&]&,chk],False];​​Print["WARNING: some relations are nonzero modulo ",n,". Bad solution indices: ",badIdx];)];​​​​(*6.enhancedpolynomialΦ_E(H,M)*)​​If[TrueQ[computeEnhanced],solList=vars/.soln;(*arcvectorspersolution*)imgSizes=CountDistinct/@solList;(*numberofdistinctcolorspersolution*)tallies=SortBy[Tally[imgSizes],First];(*{{m,a_m},...}sortedbym*)phiE=Total[(#[[2]])*q^(#[[1]])&/@tallies];​​Print["Tallies (m, a_m): ",tallies];​​Print["Φ_E(H, M) = ",phiE];];​​​​Null;(*endcleanly*)​​​​​​
Φ_E(H, M) = 9q+72
2
q
+72
3
q
Tallies (m, a_m): {{1,9},{2,72},{3,72}}
OK: all relations satisfied modulo 3.
|Hom(Q(H), M)| = 153
Solve time (s): 0.212
​
​
​
​
​
​
​
​
​
​
​
​
​
​
​
​
​
​
​
​
​
​
​
​
​
​
​
​
​
​
​
​
​
​
​
​
In[]:=
​
​
​
​
​
​
​
​
​
​
​
​
​
​
​
​
​
​
​
​