Constant Primes

Author

Eric W. Weisstein
December 17, 2015

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

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

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

Initialization

ConstantPrime[c_,n_]:=FromDigits[ConstantDigits[c,n]]
ConstantDigits[c_,n_]:=RealDigits[c,10,n][[1]]
ConstantList[c_,n_]:=FromDigits/@Reverse[NestList[Most,ConstantDigits[c,n],n-1]]

<<Utilities`EISFormat`

Apery

Position[ConstantList[Zeta[3],10^4],_?PrimeQ]//Flatten//Timing

FromDigits[ConstantDigits[Zeta[3],#]]&/@l

Check primality

primes={10,55,109,141};

{$MachineName,$TopDirectory,DateString[]}

Print[{#,PrimeQ[ConstantPrime[Zeta[3],#]]//Timing}]&/@primes;

Catalan

Position[ConstantList[Catalan,10^4],_?PrimeQ]//Flatten//Timing

Check Primality

{$MachineName,$TopDirectory,DateString[]}

Print[{#,PrimeQ[ConstantPrime[Catalan,#]]//Timing}]&/@primes;

Champernowne

A071620

A176942

cons=ChampernowneNumber[10];
digs[n_]:=Floor[cons 10^n]

digs[20]

l={};
c=N[ChampernowneNumber[10],10^4];
digs[n_]:=Floor[c 10^n]
a=AbsoluteTime[];
n=Floor[Precision[c]];
i=1;
(While[i<n,If[(t=Timing[PrimeQ[digs[i]]])[[2]],AppendTo[l,i];Print[{t[[1]],AbsoluteTime[]-a,i}]];i++];l)//Timing

c=N[ChampernowneNumber[10],10^5];
digs[n_]:=Floor[c 10^n]

l={};
a=AbsoluteTime[];
n=Floor[Precision[c]];
i=1;
(Monitor[While[i<n,If[(t=Timing[PrimeQ[digs[i]]])[[2]],AppendTo[l,i];Print[{t[[1]],AbsoluteTime[]-a,i}]];i++],i];l)//Timing

40535

Champernowne primes giving consecutive integer primes

primes={10,14,24,235,2804,4347,37735};

IntegerLength[digs[#]]&/@primes

Last[lengths=Accumulate[IntegerLength[Range[10^4]]]]//Timing

Cases[{#,MemberQ[lengths,#]}&/@primes,{n_,True}:>n]

Concatenation of the first integers giving above integer lengths are consecutive integer primes since the digits of Champernowne end in a full concatenated number.   These correspond to concatenations of the first

Position[lengths,#]&/@%//Flatten

integers giving primes, e.g.:

Range[XXX]

ConstantPrime[cons,XXX]

Table

i=0;Grid[(i++;d=ToString[digs[#]];{i,#,If[StringLength[d]<30,d,StringTake[d,9]<>"…"<>StringTake[d,-10]]})&/@primes,Alignment->{Decimal},Dividers->All]

digs/@Take[primes,3]

Export["~/a176942.txt",MapIndexed[ToString[#2[[1]]]<>" "<>ToString[#]<>"\n"&,digs/@primes]<>"\n","Lines"]

Check primality

primes={10,14,24,235,2804,4347,37735};

{$MachineName,$TopDirectory,DateString[]}

Print[{#,PrimeQ[ConstantPrime[ChampernowneNumber[10],#]]//Timing}]&/@primes;

CopelandErdos

CopelandErdosConstant[p_]:=Module[{len=0,ar="",k=1,tmp=1},
While[len≤p+IntegerLength[tmp],
len+=IntegerLength[tmp=Prime[k++]];
ar=StringJoin[ar,IntegerString[tmp]];
];
SetPrecision[ToExpression["0."<>ar],p]
]

cons=CopelandErdosConstant[10^6];
digs[n_/;n<10^6]:=Floor[cons 10^n]

primes={};
a=AbsoluteTime[];
n=Floor[Precision[cons]];
i=1;
(Monitor[While[i<n,If[(t=Timing[PrimeQ[digs[i]]])[[2]],AppendTo[primes,i];Print[{t[[1]],AbsoluteTime[]-a,i}]];i++],i];primes)//Timing

Rodenkirch search

http://www.mersenneforum.org/showthread.php?t=20661

Total[IntegerLength/@Prime[Range[PrimePi[300000]]]]

Total[IntegerLength/@Prime[Range[PrimePi[420000]]]]

Total[IntegerLength/@Prime[Range[PrimePi[550000]]]]

Total[IntegerLength/@Prime[Range[PrimePi[1*^6]]]]

Copeland-Erdos primes giving Smarandache-Wellin primes

A227530

primes={1,2,4,11,353,355,499,1171,1543,5719,11048,68433,97855,292447};

Last[lengths=Accumulate[IntegerLength[Prime[Range[3*^5]]]]]//Timing

AXXXXX

Cases[{#,MemberQ[lengths,#]}&/@primes,{n_,True}:>n]

Concatenation of the first primes giving above integer lengths are Smarandache-Wellin primes since the digits of Copeland-Erdos end in a full concatenated prime.   These correspond to concatenations of the first

A046035

Position[lengths,#]&/@%//Flatten

primes, meaning primes up to and including

Prime[%]

are prime, e.g.:

Prime[Range[128]]

ConstantPrime[cons,355]

Table

i=0;Grid[(i++;d=ToString[digs[#]];{i,#,If[StringLength[d]<30,d,StringTake[d,9]<>"…"<>StringTake[d,-10]]})&/@primes,Alignment->{Decimal},Dividers->All]

B-file

With[{s=StringReplace[ToString[N[cons,Max[primes]+100]],"."->""]},BFile["~/b227530.txt",StringTake[s,#]&/@primes]]

Rodenkirch

http://www.mersenneforum.org/showthread.php?t=20661

If I've written my code correctly then CE(292447) is PRP. Even if my code isn't correct, it is a fairly large PRP. Could someone please independently verify?

(c=digs[292447])//IntegerLength

Last[lengths=Accumulate[IntegerLength[Prime[Range[1*^5]]]]]//Timing

Position[lengths,_?(#>=292447&),1,1]

Total[IntegerLength/@Prime[Range[50578]]]

Prime[50578]

Table[Prime[n],{n,50576,50579}]

Length[IntegerDigits[c]]

d=Take[IntegerDigits[c],-50]

Grid[Table[{i,FromDigits/@Partition[Drop[d,i],6]},{i,0,5}]]

Check primality

{$MachineName,$TopDirectory,DateString[]}

Print[{#,PrimeQ[ConstantPrime[cons,#]]//Timing}]&/@primes;

Print[{#,PrimeQ[ConstantPrime[cons,#]]//Timing}]&/@Take[primes,-1];

E

Position[ConstantList[E,10^4],_?PrimeQ]//Flatten//Timing

Check primality

primes={1,3,7,85,1781,2780,112280,155025};

{$MachineName,$TopDirectory,DateString[]}

Print[{#,PrimeQ[ConstantPrime[E,#]]//Timing}]&/@primes;

EulerGamma

Position[ConstantList[EulerGamma,10^4],_?PrimeQ]//Flatten//Timing

Check primality

primes={1,3,40,185,1038,22610,179849};

{$MachineName,$TopDirectory,DateString[]}

Print[{#,PrimeQ[ConstantPrime[EulerGamma,#]]//Timing}]&/@primes;

Glaisher

Position[ConstantList[Glaisher,10^4],_?PrimeQ]//Flatten//Timing

Check primality

primes={7,10,18,64,71,527,1992,5644,8813,19692};

{DateString[],$TopDirectory}

Print[{#,PrimeQ[ConstantPrime[Glaisher,#]]//Timing}]&/@primes;

GoldenRatio

Position[ConstantList[GoldenRatio,10^4],_?PrimeQ]//Flatten//Timing

Check primality

primes={7,13,255,280,97241};

{$MachineName,$TopDirectory,DateString[]}

Print[{#,PrimeQ[ConstantPrime[GoldenRatio,#]]//Timing}]&/@primes;

GolombDickman

MathConstant["GolombDickman"]//Precision

Precision[λ=Get["/Developer/eww/Constants/GolombDickman_1_10_4.m"]]

λ==MathConstant["GolombDickman"]

N[λ,10]

Compute

a=AbsoluteTime[];
n=Precision[λ];
dig=RealDigits[N[λ,n]][[1]];
i=1;
primes={};
(Monitor[While[i<n,If[(t=Timing[PrimeQ[FromDigits@Take[dig,i]]])[[2]],AppendTo[primes,i];Print[{t[[1]],AbsoluteTime[]-a,i}]];i++],i];primes)//Timing

Check primality

primes={6,27,57,60,1659,2508};

{$MachineName,$TopDirectory,$Version,DateString[]}//Column

Print[{#,PrimeQ[ConstantPrime[λ,#]]//Timing}]&/@primes;

Khinchin

MathConstant["Khinchin"]//Precision

Position[ConstantList[MathConstant["Khinchin"],10^4],_?PrimeQ]//Flatten//Timing

Check primality

primes={1,407,878,4443,4981,6551,13386,28433};

{$MachineName,$TopDirectory,DateString[]}

Print[{#,PrimeQ[ConstantPrime[MathConstant["Khinchin"],#]]//Timing}]&/@primes;

NaturalLog2

A228226

cons=Log[2];

Position[ConstantList[cons,10^4],_?PrimeQ]//Flatten//Timing

B-file

primes={321,466,1271,15690,18872,89973};

With[{s=StringReplace[ToString[N[cons,Max[primes]+100]],"."->""]},BFile["~/b228226.txt",StringTake[s,#]&/@primes]]

Check primality

{$MachineName,$TopDirectory,DateString[]}

Print[{#,PrimeQ[ConstantPrime[cons,#]]//Timing}]&/@primes;

NaturalLog10

cons=Log[10];

Position[ConstantList[cons,10^3],_?PrimeQ]//Flatten//Timing

B-file

primes={1,2,40,242,842,1541,75067};

With[{s=StringReplace[ToString[N[cons,Max[primes]+100]],"."->""]},BFile["~/b228241.txt",StringTake[s,#]&/@primes]]

Check primality

{$MachineName,$TopDirectory,DateString[]}

Print[{#,PrimeQ[ConstantPrime[cons,#]]//Timing}]&/@primes;

Pi

Method 1

Position[ConstantList[Pi,10^4],_?PrimeQ]//Flatten//Timing

Method 2

Print[{#,PrimeQ[ConstantPrime[Pi,#]]//Timing}]&/@l;

Method 3

a=AbsoluteTime[];
n=l[[-1]];
dig=RealDigits[N[Pi,n]][[1]];
i=1;
While[i<n,If[(t=Timing[PrimeQ[FromDigits@Take[dig,i]]])[[2]],Print[{t[[1]],AbsoluteTime[]-a,i}]];i++]//Timing

Check primality

primes={1,2,6,38,16208,47577,78073};

{$MachineName,$TopDirectory,DateString[]}

Print[{#,PrimeQ[ConstantPrime[Pi,#]]//Timing}]&/@primes;

Pythagoras

cons=(Sqrt[2]);

Position[ConstantList[cons,10^4],_?PrimeQ]//Flatten//Timing

Check primality

primes={55,97,225,11260,11540};

{$MachineName,$TopDirectory,DateString[]}

Print[{#,PrimeQ[ConstantPrime[cons,#]]//Timing}]&/@primes;

Soldner

μ=x/.FindInstance[LogIntegral[x]==0&&x>0,x,Reals][[1]]

Soldner[n_]:=x/.FindRoot[LogIntegral[x],{x,14/10},WorkingPrecision->n+200,PrecisionGoal->n+10];

Select[ConstantList[Soldner[1000],1000],PrimeQ]

Position[ConstantList[Soldner,10^3],_?PrimeQ]//Flatten//Timing

Position[ConstantList[Soldner[10^4],10^4],_?PrimeQ]//Flatten//Timing

Check primality

primes={4,144,227,444,19474};

{$MachineName,$TopDirectory,DateString[]}

Print[{#,PrimeQ[ConstantPrime[Root[{LogIntegral[#1]&,1.4513692348833810502839684858920274494930322836480158630931`30.15051499783199}],#]]//Timing}]&/@primes;

Theodorus

cons=(Sqrt[3]);

Position[ConstantList[cons,10^4],_?PrimeQ]//Flatten//Timing

Check primality

primes={2,3,19,111,116,641,5411,170657};

{$MachineName,$TopDirectory,DateString[]}

Print[{#,PrimeQ[ConstantPrime[cons,#]]//Timing}]&/@primes;