Irregular Prime

Author

Eric W. Weisstein
December 1, 2005

This notebook downloaded from http://mathworld.wolfram.com/notebooks/PrimeNumbers/IrregularPrime.nb.

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

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

Code

IrregularPrimeQ[p_Integer?Positive]:=Mod[#,p]==0&/@(Or@@Numerator/@BernoulliB/@Range[2,p-3,2])

About the same speed but slightly slower

IrregularPrimeQ[p_Integer?Positive]:=Times@@(Mod[#,p]&/@Numerator/@BernoulliB/@Range[2,p-3,2])==0

Enumeration

v5.1

Select[Prime[Range[100]],IrregularPrimeQ]//Timing

Length[b=ReadList["/Volumes/Data/Math/BernoulliB.txt"]]//Timing

ByteCount[b]/10^6. Megabyte

nmax=PrimePi[2Length[b]+3]

irregularPrimeQ[p_Integer?Positive]:=Mod[#,p]==0&/@(Or@@Numerator/@Take[b,Ceiling[(p-3)/2]])

Timing[irr=Select[Prime[Range[nmax]],irregularPrimeQ]]

v6

Do[
Print[{100n,irr=Select[Prime[Range[100n]],IrregularPrimeQ];//Timing,
Table[Count[irr,_?(#<10^k&)],{k,6}],
{MemoryInUse[],MaxMemoryUsed[]}/10.^6 MB}],{n,500}]

numer((Subscript[B, n])/n) is prime

(l=Select[Range[2,1000,2], PrimeQ[Numerator[BernoulliB[#]/#]]&])//Timing

(l=Select[Range[2,5000,2], PrimeQ[Numerator[BernoulliB[#]/#]]&])//Timing

Do[
Print[{i,n=l[[i]], IrregularPrimeQ[Abs[Numerator[BernoulliB[n]/n]]]//Timing}],{i,Length[l]}]

Largest Known

Largest Proven irregular prime

http://primes.utm.edu/primes/page.php?id=87451

(6/2153)BernoulliB[4306]//IntegerLength

PrimeQ[(6/2153)BernoulliB[4306]]//Timing

IrregularPrimeQ[(6/2153)BernoulliB[4306]]//Timing

Oakes (Largest *proven* irregular prime)

b2370=b[[2370/2]];

Short[b2370]

IntegerLength[bigirr=33957462BernoulliB[2370]/40685]

PrimeQ[bigirr]//Timing

bigirr//IntegerQ

IrregularPrimeQ[bigirr]//Timing

Andersen, Aug 2005

irr2=6BernoulliB[5534]/226840561549600012633271691723599339;

IntegerQ[irr2]

Digits[irr2]

PrimeQ[irr2]//Timing

Noe, Sep. 28, 2005

irr3=-Numerator[BernoulliB[22808]/22808];//Timing

IntegerQ[irr3]

Digits[irr3]

Length[IntegerDigits[irr3]]

PrimeQ[irr3]//Timing

Density

Computation

Length[b=ReadList["/Volumes/Data/Math/BernoulliB.m"]]//Timing

With[{n=PrimePi[10^4]},
Print[Length[irr=Flatten[Position[Prime[Range[n]],_?irregularPrimeQ]]]/n//N//Timing];
a=Table[0,{n}];
a[[irr]]=1;
frac=Rest[FoldList[Plus,0,a]];
]

N[1-1/(Sqrt[E])]

Prime[Last[irr]]

{Length[irr],Last[irr],N[Length[irr]/PrimePi[Last[irr]],10]}//Timing

Plot

<<Graphics`Colors`

ListPlot[MapIndexed[{Prime[#2[[1]]],#1/#2[[1]]}&,frac],PlotJoined->True,PlotStyle->Red,AxesLabel->TraditionalForm/@{p,f},
Epilog->{Blue,Line[{{0,#},{10^6,#}}]&[1-1/Sqrt[E]]},
PlotRange->{0,.45}]

Counts

Table[Count[Prime/@irr,_?(#<10^n&)],{n,0,4}]

Prime/@irr