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?