Palindromic Number

Author

Eric W. Weisstein
August 25, 2015

This notebook downloaded from http://mathworld.wolfram.com/notebooks/IntegerSequences/PalindromicNumber.nb.

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

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

Code

Enumeration

p=Select[Range[2000],PalindromicQ]

Powers of 10

V10.2

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

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

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

{Timing[p=Select[Range[10^8],PalindromicQ];],MaxMemoryUsed[]/10^9.GB}

{Timing[p=Select[Range[10^9],PalindromicQ];],MaxMemoryUsed[]/10^9.GB}

Table[Length[Select[p,#<10^n&]],{n,9}]

V10.3

IntegerQ[Range[10]]

Total[Boole[PalindromeQ/@Range[10]]]

tot=0;
Do[
Print[{i,tot+=Total[Boole[PalindromeQ/@Range[(10^(i-1)),(10^i)-1]]]//Timing}],{i,8}]

Exact

Table[If[EvenQ[n],2((10^(n/2))-1),11 (10^((n-1)/2))-2],{n,9}]

Not the Sum of Two Palindromes

Two or Fewer

Take[Complement[Range[Last[p]],
p,
Select[Union[Flatten[Outer[Plus,p,p]]],#≤Last[p]&]],110]

Take[Complement[Range[Last[p]],
Select[Union[Flatten[Outer[Plus,Prepend[p,0],Prepend[p,0]]]],#≤Last[p]&]],110]

Exactly Two

Take[Complement[Range[Last[p]],
Select[Union[Flatten[Outer[Plus,p,p]]],#≤Last[p]&]],110]

Plot

V5

<<Utilities`Plot`

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

plot1=IntegerListPlot[Take[p,40],PlotStyle->Red,PlotJoined->True,
AxesLabel->TraditionalForm/@{n,ylabel}]

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

Show[GraphicsArray[{plot1,plot2}],ImageSize->500]

V6

<<Utilities`Plot`

In V9, RawBoxes has a StripOnInput option which you could use.

  Graphics[{}, Axes -> True, 
   AxesLabel -> RawBoxes[RowBox[{"2", "+"}], StripOnInput -> False]]

That's really the right way, but since this is W|A and thus presumably stuck with V8, that won't help you for now. Dynamic + RawBoxes is heavier weight, but should do what you want.

  Graphics[{}, Axes -> True, 
   AxesLabel -> Dynamic[RawBoxes[RowBox[{"2", "+"}]]]]

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

plot1=IntegerListPlot[Take[p,40],PlotStyle->Red,PlotJoined->True,
AxesLabel->{n,Dynamic@RawBoxes@RowBox[{"\[LeftBracketingBar]",RowBox[{"{",RowBox[{"k","≤",RowBox[{"n",":",RowBox[{"k"," ","is"," ","palindromic"}]}]}],"}"}],"\[RightBracketingBar]"}]}]

plot2=ListPlot[MapIndexed[{#1,#2[[1]]}&,Take[p,118]],PlotStyle->Red,Joined->True,
AxesLabel->{n,Dynamic@RawBoxes@RowBox[{"\[LeftBracketingBar]",RowBox[{"{",RowBox[{"k","≤",RowBox[{"n",":",RowBox[{"k"," ","is"," ","palindromic"}]}]}],"}"}],"\[RightBracketingBar]"}]}]

GraphicsRow[{plot1,plot2}]

Sum of Reciprocals

{Length[p],Last[p]}

Total[1`30/p]

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

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

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

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

Palindromic Squares

(l=Length[IntegerDigits[#]]&/@Select[Table[n^2,{n,10^6}],PalindromicQ])//Timing

Complement[Range[Max[l]],l]