A124882 Maximum number of distinct squares in arithmetic progression modulo prime(n).
2, 2, 3, 3, 3, 4, 5, 4, 5, 4, 4, 4, 5, 5, 5, 6, 5, 6, 6, 7, 9, 6, 7, 6, 9, 7, 7, 6, 10, 5, 7, 8, 6, 5, 6, 7, 6, 6, 6, 6, 6, 6, 7, 9, 7, 6, 7, 7, 7, 6, 7, 7, 13, 7, 6, 7, 9, 7, 10, 7, 9, 9, 7, 11, 9, 7, 8, 9, 8, 6, 8, 8, 9, 6, 8, 8, 8, 8, 9, 13, 8, 12, 7, 9, 10, 8, 9, 9, 8, 8, 11, 13, 8, 8, 10, 8, 9, 8, 10, 10
Offset: 1
Keywords
Examples
Consider numbers modulo 13, the 6th prime. The squares mod 13 are 0,1,3,4,9,10,12. Exhaustive search finds that the four numbers 1,9,17,25 are in AP and are also distinct squares modulo 13. Hence a(6)=4. There are two other APs of squares having the same length: 4,10,16,22 and 10,12,14,16. From _Travis Scott_, May 28 2022: (Start) Taking the same example on Z/13Z but with no information other than the residues < 13/2 (0,1,3,4) and the polarity of 13 (+) we find that the string RRNRRNN adjusted to (2k-1)RRR N RR NNNN(2k) has no longer run in any color than NNNN so a(6)=4. We can also use the N values of that run to show a maximal AP of squares mod 13 starting from every residue: 2 * 5,6,7,8 = 10,12, 1, 3 = 10,12,14,16 5 * 5,6,7,8 = 12, 4, 9, 1 = 12,17,22,27 6 * 5,6,7,8 = 4,10, 3, 9 = 4,10,16,22 7 * 5,6,7,8 = 9, 3,10, 4 = 9,16,23,30 8 * 5,6,7,8 = 1, 9, 4,12 = 1, 9,17,25 11 * 5,6,7,8 = 3, 1,12,10 = 3,14,25,36. (End)
Links
- K. S. Brown, Squares in Arithmetic Progression (mod p)
- Pablo Saez, X. Vidaux, and M. Vsemirnov, Optimal bounds for Buchi's problem in modular arithmetic, Journal of Number Theory Volume 149, April 2015, Pages 368-403.
Programs
-
Mathematica
t=Table[p=Prime[n]; sqs=Sort[Mod[Range[0,(p-1)/2]^2,p]]; kMx=0; Do[If[i!=j, df=sqs[[j]]-sqs[[i]]; k=2; While[MemberQ[sqs, Mod[sqs[[i]]+k*df,p]], k++ ]; k--; If[k>kMx, kMx=k]], {i,Length[sqs]}, {j,Length[sqs]}]; kMx+1, {n,2,PrimePi[617]}]; Join[{2},t] (* alternate program *) Qres1C=Compile[{{x,_Integer,1},{q,_Integer,0}},Module[{s=0,z=0,i=2},While[x[[i]]==x[[i-1]],i++];z=2i-1;s=i;While[i
"C",RuntimeAttributes->{Listable},Parallelization->True]; QresIC=Compile[{{x,_Integer,1},{q,_Integer,0}},Module[{s=2,z=2},Do[If[x[[i]]==x[[i-1]],s++,If[s>z,z=s];s=1],{i,2,q}];If[s>z,z=s];z],CompilationTarget->"C",RuntimeAttributes->{Listable},Parallelization->True]; {2}~Join~Table[If[Mod[p,4]==1,Qres1C[#,(p+1)/2],QresIC[#,(p-1)/2]]&@Unitize[PowerMod[Range[(p-1)/2],(p-1)/2,p]-1],{p,Prime@Range[2,6543]}] (* Travis Scott, May 28 2022 Accelerated by symmetry per comment. *)
Comments