Palindromic Prime

Author

Eric W. Weisstein
January 16, 2012

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

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

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

Code

Enumeration

Enumeration

(10^7)

Timing[p=Select[Range[10^7],PalindromicQ];]

Length[pp=Select[p,PrimeQ]]//Timing

MaxMemoryUsed[]/1024.^3GB

(10^8)

Timing[p=Select[Range[10^8],PalindromicQ];]

Length[pp=Select[p,PrimeQ]]//Timing

MaxMemoryUsed[]/1024.^3GB

Numbers of Digits

Table[Count[pp,_?(Length[IntegerDigits[#]]==n&)],{n,8}]

Powers of 10

Table[Count[pp,_?(#<10^n&)],{n,7}]

Bases

Table[{b,FromDigits[IntegerDigits[#,b]]&/@Take[#,10]&@Select[Range[5000],PrimeQ[#]&&PalindromicQ[#,b]&]},{b,2,10}]//ColumnForm

Large Palindromic Primes

http://primes.utm.edu/top20/page.php?id=53# records

275495 digits

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

IntegerLength[p=Cyclotomic[3, 10^137747]+ (137 10^137748 + 731  10^129293)(10^8454 - 1)/999]

PalindromicQ[p]

104281 digits ((10^104281)-(10^52140)-1)

p=10^104281-10^52140-1;

Length[IntegerDigits[p]]

PalindromicQ[p]

PrimeQ[p]//Timing

130023 digits (Dubner Record)

Date: Fri, 19 Nov 2004 11:23:29 -0500
From: Harvey Dubner <harvey@dubner.com>
To: NMBRTHRY@LISTSERV.NODAK.EDU
Subject: New palindromic prime record

p=With[{z=65007},FromDigits[{1,Sequence@@Table[0,{z}],3,7,6,1,6,7,3,Sequence@@Table[0,{z}],1}]
];

Length[IntegerDigits[p]]

PalindromicQ[p]

PrimeQ[p]//Timing

150007 digits (Jobling Record)

Dec. 26, 2005

p=10^150006+7426247*10^75000+1;

Length[IntegerDigits[p]]

PalindromicQ[p]

PrimeQ[p]//Timing

160017 digits (Dubner 2006 Record)

IntegerLength[p=10^160016+8231328*10^8005+1]

PalindromicQ[12321]

i=IntegerDigits[p];

Position[Equal@@@Transpose[{i,Reverse[i]}],False,1,1]

{i[[8005]],i[[-8005]]}

{i[[8006]],i[[-8006]]}

180055 digits (8 (10^60744) (Subscript[R, 58567])+(10^180054)+1)

IntegerLength[p=10^180054+8Repunit[58567]10^60744+1]

PalindromicQ[p]

PrimeQ[p]//Timing

Reflected Expansion of Pi

digs[n_]:=FromDigits[Flatten[{#,Reverse[Most[#]]}&[RealDigits[Pi,10,n][[1]]]]]

digs[2]

Select[digs/@Range[500],PalindromicQ[#]&&PrimeQ[#]&]//Timing

2{1,2,27,151,461,2056}-1

Select[FromDigits/@(Join[#,Reverse[Most[#]]]&/@Reverse[Most[NestList[Most,#,Length[#]]&[RealDigits[Pi,10,500][[1]]]]]),PrimeQ[#]&&PalindromicQ[#]&]//Timing

Select[FromDigits/@(Join[#,Reverse[Most[#]]]&/@Reverse[Most[NestList[Most,#,Length[#]]&[RealDigits[Pi,10,1000][[1]]]]]),PrimeQ[#]&&PalindromicQ[#]&]//Timing

Plot

MakeBoxes[ylabel,TraditionalForm]:=RowBox[{"\[LeftBracketingBar]",RowBox[{"{",RowBox[{"k","≤",RowBox[{"n",":",RowBox[{"k"," ",Cell["is a palindromic prime"]}]}]}],"}"}],"\[RightBracketingBar]"}]

ListPlot[MapIndexed[{#1,#2[[1]]}&,Take[pp,100]],PlotStyle->Red,PlotJoined->True,
AxesLabel->TraditionalForm/@{n,ylabel}]

Sum of Reciprocals (Honaker's Constant)

ListPlot[Rest[FoldList[Plus,0,1./pp]],PlotJoined->True,PlotStyle->Red]

{Length[pp],Last[pp]}

Total[1`30/pp]

SequenceLimit[FoldList[Plus,0,1`50/pp]]

SequenceLimit[FoldList[Plus,0,1`100/pp]]

SequenceLimit[FoldList[Plus,0,1`200/pp]]

SequenceLimit[FoldList[Plus,0,1`300/pp]]