Prime-Generating Polynomials

Author

Eric W. Weisstein
January 27, 2019

This notebook downloaded from http://mathworld.wolfram.com/notebooks/PrimeNumbers/Prime-GeneratingPolynomial.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/Prime-GeneratingPolynomial.html.

©2019 Wolfram Research, Inc. except for portions noted otherwise

Additional Authors

Visualization of quadratic prime-generating polynomials by
Michael Trott

Compilation of polynomials by
Ed Pegg, Jr.

Graphic

Michael Trott

cf[V_]:=cf[V]=Compile[{{a,_Integer},{b,_Integer}},Module[{x1,x2,values},
x1=(-a-Sqrt[4.(V-b)+0. I+a^2])/2.;
x2=(-a+Sqrt[4.(V-b)+0. I+a^2])/2.;
If[Im[x1]=!=0.&&Im[x2]=!=0.,0,values=Table[x^2+a x+b,{x,Ceiling[Re[x1]],Floor[Re[x2]]}];
Length[Intersection[values,#]]]]]&[Prime[Range[PrimePi[V]]]];

V5

With[{o=200},
ListDensityPlot[Table[cf[1000][a,b],{b,-o,o},{a,-o,o}],Mesh->False,ColorFunction->(Hue[0.8 #]&),FrameLabel->TraditionalForm/@{a,b}]
]//Timing

V7

With[{o=200},
ArrayPlot[Table[cf[1000][a,b],{b,-o,o},{a,-o,o}],Mesh->False,ColorFunction->(Hue[0.8 #]&),FrameLabel->{a,b},FrameTicks->True,ImageSize->400,DataRange->{{-200,200},{-200,200}}]
]

cf[1000][1,41]

Prime[-4]

With[{x=75},
ListDensityPlot[Table[Log@NumberOfPrimes[a,If[b==0,0,Prime[Abs[b]]Sign[b]]],{a,-x,x},{b,-x,x}],ColorFunction->(Hue[#/5]&),Mesh->False]
]//Timing

p=With[{x=50},
Table[NumberOfPrimes[a,Prime[b]],{a,-x,x},{b,x}]];

Max[Flatten[p]]

Position[p,54]

NumberOfPrimes[24-51,Prime[48]]

NumberOfDifferentPrimes[24-51,Prime[48]]

{24-51,Prime[48]}

Table[n^2-27n+223,{n,0,53}]

p2=With[{x=50},
Table[NumberOfDifferentPrimes[a,Prime[b]],{a,-x,x},{b,x}]];

Max[Flatten[p2]]

{#1-51,Prime[#2]}&@@@Position[p2,40]

With[{x=75},
ListDensityPlot[Table[Log@NumberOfDifferentPrimes[a,If[b==0,0,Prime[Abs[b]]Sign[b]]],{a,-x,x},{b,-x,x}],ColorFunction->(Hue[#/5]&),Mesh->False]
]//Timing

Bad polynomials

Shanks

Or@@PrimeQ[((Range[3094])^6)+1091]

Position[((Range[10^5])^6)+1091,_?PrimeQ]//Flatten//Timing

Carmody

Position[((Range[10^5])^6)+29450922301244534,_?PrimeQ]//Flatten//Timing

Position[((Range[10^6])^6)+29450922301244534,_?PrimeQ]//Flatten//Timing

Examples

ConsecutivePrimeCount[p_,n_]:=NestWhile[#+1&,0,Function[n,PrimeQ[p]]]-1
DistinctConsecutivePrimeCount[p_,n_]:=CountDistinct[Function[n,p]/@Range[0,ConsecutivePrimeCount[p,n]]]

polys={
{(1/4) (-6823316+1720294 n-158379 (n^2)+6729 (n^3)-133 (n^4)+(n^5)),"Dress and Landreau (2002), Gupta (2006)"},{(1/36) (34747236-13055316 n+1987786 (n^2)-153066 (n^3)+6217 (n^4)-126 (n^5)+(n^6)),"Wroblewski and Meyrignac (2006)"},{213589-45458 n+3294 (n^2)-97 (n^3)+(n^4),"Beyleveld (2006)"},{-286397+348272 n-56822 (n^2)+3588 (n^3)-99 (n^4)+(n^5),"Wroblewski and Meyrignac (2006)"},{251831-60897 n+3845 (n^2)-66 (n^3),"Kazmenko and Trofimov (2006)"},{250703-26436 n+270 (n^2)+42 (n^3),"Jaroslaw Wroblewski and Jean-Charles Meyrignac"},
{41-n+(n^2),"Euler (1772)"},
{29+2 (n^2),"Legendre (1798)"},
{17+n+(n^2),"Legendre"},
{59+4 n+4 (n^2),"Honaker"},
{11+2 (n^2),"A050265"},
{10181-1701 n+47 (n^2),"Fung and Ruby"},
{2753-810 n+36 (n^2),"Fung and Ruby"},
{50383-4707 n+103 (n^2),"Speiser (pers. comm., Jun. 14, 2005)"},{-18757+3318 n-183 (n^2)+3 (n^3),"S. M. Ruiz (pers. comm., Nov. 20, 2005)"},{101+29 (n^2)+(n^4),"E. Pegg, Jr. (pers. comm., Jun. 14, 2005)"},
{17+(n^2)+(n^3),"A050266"},
{4871-371 n+7 (n^2),"F. Gobbo (pers. comm., Dec. 26, 2005)"},
{7243-488 n+8 (n^2),"F. Gobbo (pers. comm., Dec. 27, 2005)"},
{2971-537 n+43 (n^2),"J. Brox (pers. comm., Mar. 27, 2006)"},
{4903-342 n+6 (n^2),"J. Brox (pers. comm., Mar. 27, 2006)"},
{37+39 n+3 (n^2),"Antonio Bruno (pers. comm., Jun. 12, 2009)"},
{3n(n+1)+23,"Ray Frame by letter, Dec. 30, 2018"},
{3n(n+1)+11,"Ray Frame by letter, Dec. 30, 2018"}
};

TextGrid[ReverseSortBy[{
Expand[#1]//Factor,
ConsecutivePrimeCount[#1,n],
DistinctConsecutivePrimeCount[#1,n],
#2
}&@@@polys,#[[3]]&],Alignment->{{Left,Decimal,Decimal,Left}}]//TraditionalForm

Gaukman

FullSimplify[((2+Sqrt[3])^p+(2-Sqrt[3])^p)/4]

Table[Prime[n],{n,10}]

Expand[Table[(((2 + Sqrt[3])^#1 + (2 - Sqrt[3])^#1)/4 & )[Prime[n]], 
   {n, 10}]]

PrimeQ[%]

Position[%,False]