[Date Index] [Thread Index] [Author Index]

The 196-Algorithm

• To: mathgroup at smc.vnet.net
• Subject: [mg20210] The 196-Algorithm
• From: Hans Havermann <haver at total.net>
• Date: Wed, 6 Oct 1999 21:06:29 -0400
• Sender: owner-wri-mathgroup at wolfram.com

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

Some 10 years ago, John Walker looped this algorithm (for n=196) 2415836
times to obtain a number containing one million digits. Five years later,
Tim Irvin extended the computation to obtain a number containing two
million digits.

I was wondering how well today's Mathematica fared with yesterday's
mainframes. Specifically, can we loop the algorithm 2415836 times in
reasonable time?

q[n_] := (i++; r = FromDigits[Reverse[IntegerDigits[n]]];
    If[r != n, r + n, n])
i = 0; s = NestWhile[q, 89, Unequal, 2]; {i, s}

{25, 8813200023188}

NestWhile is a Mathematica 4 addition:

?NestWhile

NestWhile[f, expr, test] starts with expr, then repeatedly applies f until
applying test to the result no longer yields True. NestWhile[f, expr, test,
m] supplies the most recent m results as arguments for test at each step...

i = 0; s = NestWhile[q, 196, Unequal, 2]; {i, s}

Interrupting the evaluation and entering the inspector dialog...

i
Log[r] // N

10553
10059.9

Ignoring the matter of even comparing successive terms to see if, in fact,
we have reached a palindrome, we have, more simply...

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

s = Nest[p, 196, 10000]; // Timing
{253.6 Second, Null}

s = Nest[p, 196, 100000]; // Timing
{55416.7 Second, Null}

So it doesn't appear I can reach several million iterations in good time.
Any possibility of speeding this up?