196-Algorithm

Author

Eric W. Weisstein
September 24, 2004

This notebook downloaded from http://mathworld.wolfram.com/notebooks/IntegerSequences/196-Algorithm.nb.

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

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

Additional Authors

Exposition and original code by
Mark Sofroniou
February 16, 2002

Code

PalindromicQ[n_]:=Module[{l=IntegerDigits[n]},
l===Reverse[l]
]

Slightly faster but less elegant

Algorithm196::usage="Algorithm196[n,it] repeatedly applies the 196-Algorithm to a starting integer until a palindromic number is obtained.  If <it> is specified, only <it> iterations are done (unless a palindromic number is obtained earlier)."

Algorithm196[n_Integer?PalindromicQ,it_:0]:={n}
Algorithm196[n_Integer?Positive,it_:Infinity]:=FixedPointList[#+ToExpression[StringReverse[ToString[#]]]&,n,it,SameTest->(PalindromicQ[#2]&)]

Slightly slower but more elegant

Algorithm196b[n_Integer?PalindromicQ,it_:0]:={n}
Algorithm196b[n_Integer?Positive,it_:Infinity]:=FixedPointList[#+FromDigits[Reverse[IntegerDigits[#]]]&,n,it,SameTest->(PalindromicQ[#2]&)]

Examples

(a1=Algorithm196[196,5000]);//Timing

(a2=Algorithm196b[196,5000]);//Timing

Algorithm196[196,20]

Table[Last[Algorithm196[n]],{n,20}]

Mark's Exposition

Brief history

A palindromic number is any number which has the same value when read from either direction.
    
    Write down a number.
    Under it write down the number you get by reversing the digits in your original number.
    Add the two numbers.
    If the number is a palindrome,stop.
    If the number is not a palindrome,under it write down the number you get by reversing its digits.
    Add these two numbers.
    Repeat this process until you get a palindrome.

See the following URL for a description of the problem and some relevant links.

http://www.treasure-troves.com/math/196-Algorithm.html

John Walker spent 3 years computing the first 2,415,836 iterations starting on August 12, 1987 on a Sun 3 workstation.

http://www.fourmilab.ch/documents/threeyears/threeyears.html

Tim Irvin spent from July 5th 1995 - August 22nd 1995 computing a 2-million digit number on a Concurrent Computer Corporation Maxion model 9502.

http://www.fourmilab.ch/documents/threeyears/two_months_more.html

Timings given here are for a Pentium II at 450 Mhz.

Efficient Implementation

This function preprocesses the input, tries a number of iterations to find a palindromic number in a specified base and postprocesses the result to return a number. You can extend the computation by reapplying the function to the result.

Default[FindPalindrome, 2] = 10;
Default[FindPalindrome, 3] = Infinity;

FindPalindrome[seed_, base_.,maxtries_.]:=
Module[{init, res},
init = IntegerDigits[seed, base];
res = FixedPoint[NextDigitSequence[#, base]&,init, maxtries];
FromDigits[res, base]
]

This compiled function works with the internal list representation in a specified base. It reverses the list, checks for a palindrome and then propagates carries in the specified arithmetic base.

NextDigitSequence =
Compile[{{y, _Integer, 1},{base,_Integer}},
Block[{digit = 0, carry = 0, x = Reverse[y]}, 
(* Check for a palindrome *)
If[SameQ[x,y], Return[y]];
(* Add the list and the reversed form *)
x = x+y;
(* Propagate carries - do this in place to save space *)
Do[
digit = Part[x,i] + carry; 
carry = Quotient[digit,base];
Part[x,i] =Mod[digit,base],
{i, Length[x],1,-1}];
(* Append the final carry if present *)
 If[carry==0, x, Join[{carry},x]]
]
];

Complexity

The cost of the pre and post processing using IntegerDigits and FromDigits is O(log(n) M(n)) where M(n) is the cost of multiplication of two n-bit numbers. The input is small compared to the output and so the cost of IntegerDigits is negligible. Comparing with the sum of the work at each step (below) the cost of FromDigits can also effectively be ignored from the overall cost.

The main cost of the algorithm is in the addition and carry propagation of the intermediary form. At each step we have a number with n bits, we add a number with n bits and propagate carries to get a number with n+1 bits in the worst case. For k iterations we can then sum the work at each step to obtain

Sum[C n,{n,k}]

Therefore the algorithm has complexity O(k^2) in the number fo steps k. In other words, doubling the number of iterations yields a four fold increase in execution time.

Timing

This suggested program performs base conversion at each iteration and so has higher than quadratic complexity in the number of iterations - this will show up particularly for a large number of iterations.

p[n_]:=n+FromDigits[Reverse[IntegerDigits[n]]];

tries = 5000;

output1=Nest[p,196,tries];//Timing

output2 = FindPalindrome[196, 10,tries];//Timing

Check that the result is correct.

SameQ[output1,output2]

Doubling the number of iterations yields an increase in running time that is worse than quadratic.

tries = 10000;

s=Nest[p,196,tries];//Timing

This takes roughly four times as long as the program for 5000 iterations, which confirms the quadratic complexity.

t = FindPalindrome[196, 10,tries];//Timing

Estimation of run time

Since we know our implementation is quadratic, we can use Fit to find a least squares estimate of the constants of proportionality. I added a few extra data points to make the estimate a little more precise.

data = {{5000,15.28},{10000,58.28},{20000,231.21},{40000,910.89}};

RunningTime = Fit[data,{1,k,k^2},k]

This estimates the running time in seconds that would be required for 250,000 iterations.

RunningTime /. k->250000

Checking the estimation of run time

This computes 250,000 iterations. The running time is within 10% of the estimated value.

FindPalindrome[196,10, 250000];//Timing

The program is time-intensive, not memory intensive, since it does the majority of work in place.

MaxMemoryUsed[]

MemoryInUse[]

This updates the estimate of complexity using the larger data value.

data = {{5000,15.28},{10000,58.28},{20000,231.21},{40000,910.89},{250000,38199.69}};

RunningTime = Fit[data,{1,k,k^2},k]

Carrying out this many iterations will take approximately 42 days.

RunningTime /. k->2415836

%/(3600 24)

NextDigitSequence could be replaced with a MathLink program to avoid the overhead of checking each machine integer operation that the CompiledFunction must do.

Palindrome

FindPalindrome[196,10,20]

Table[FindPalindrome[i,10,200],{i,20}]

Position[Table[FindPalindrome[i,10,500],{i,1000}],_?(Not[PalindromicQ[#]]&)]//Flatten

Position[Table[FindPalindrome[i,10,1000],{i,1000}],_?(Not[PalindromicQ[#]]&)]//Flatten