Collatz optimization

Question

I'm VERY new to Mathematica programming (and by new I mean two days), and was solving Project Euler question 12, which states:

Which starting number, under one million, produces the longest [Collatz] chain?

Now don't take this question wrong. I am not asking for a solution, I am simply wondering why my proposed solution is taking so long to produce an answer. It does eventually produce the correct solution to the problem.

My code is below:

collatzLength[x_] := Module[{c, n}, (For[n = x; c = 1, n != 1, c += 1, 
    If[EvenQ[n], n = n/2, n = 3*n + 1]]); c]
Last@Flatten@(MaximalBy[Transpose@{(collatzLength /@ 
     Range[1000000]), Range[1000000]}, First])

It seems that the collatzLength /@ Range[1000000] is what is taking so long, so I am wondering how I can improve the collatz function (or any of the code) so that it completes in a reasonable timeframe.

many more collatz algorithmic ideas here, & hope to hear from others in [chat] — vzn, Jun 12 '15 at 17:21

score 18 · Accepted Answer · edited Jan 02 '15 at 19:55

18

You´ll find a lot of Mathematica Code on the internet regarding this problem. Your code generates the collate sequence for every number without taking into account, that there are a lot of duplicate calculations. You can approach it via

collatz[n_] := collatz[n] = If[EvenQ[n], n/2, 3*n + 1]

to remember the calculations, then...

collatzSequence[n_] := NestWhileList[collatz, n, #1 > 1 &]

and

Length /@ (collatzSequence /@ Range[2, 1000000]) // Max

to calculate.

Speed could be improved by compiling the definition of collatz

edited Jan 02 '15 at 19:55

globby

245
1
7

answered Dec 30 '14 at 22:33

mgamer

5,593
18
26

Can you extend memoization for example to parametrized version collatz[a_,b_][n_] where {a,b} generalize {3,1}? – alancalvitti Dec 31 '14 at 18:03
Also, might as well divide 3*n + 1 by 2, saves redundant steps. – alancalvitti Dec 31 '14 at 18:04
@ alancalvitti: A "quick and dirty" approach can be:collatz[args_] := collatz[args] = With[{a = args[[1]], b = args[[2]], n = args[[3]]}, If[EvenQ[n], {a, b, n/2}, {a, b, a*n + b}] ] and then collatzSequence[args_] := NestWhileList[collatz, args, Last[#] > 1 &, 10, 1000]. I terminated the NesstWhileList for security reasons. The tripple {5,1,17} has more than 1000 Iterates ;-). – mgamer Jan 01 '15 at 12:14
.... sorry the code is not shown very pretty, but readable ... – mgamer Jan 01 '15 at 12:16
1

some more detailed non-mathematica description of what this is doing (memoization? how so?) would be helpful. – vzn Aug 11 '15 at 20:51

score 7 · Answer 2 · edited Apr 13 '17 at 12:55

For extra brute force, just Compile it to C code:

collatzLength = 
 Compile[{{x, _Integer}}, 
  Module[{c, 
    n}, (For[n = x; c = 1, n != 1, c += 1, 
     If[EvenQ[n], n = Round[n/2], n = 3*n + 1]]); c], 
  CompilationTarget -> "C", RuntimeAttributes -> {Listable}]

It computes the first million lengths in under 2 seconds:

First@AbsoluteTiming@collatzLength[Range[1000000]]
(*1.248002*)

For more info on what functions are compilable, see this question.

score 6 · Answer 3 · answered Dec 30 '14 at 22:37

Your collatzLength function is fast on an individual integer, but when you map it to all integers from 1 to a million, the function recalculates values repeatedly. For example, the Collatz series for $n=10$ is $\{10,5,16,8,4,2,1\}$. But the length for $n=5$ would have been already calculated to be 6. Hence, the Collatz length for $n=10$ is $1+6=7$. Use memoization to store previous values. For example,

CollatzLength[1]:=1
CollatzLength[n_]:=(CollatzLength[n]=...)/;EvenQ[n]
CollatzLength[n_]:=(CollatzLength[n]=...)/;OddQ[n]

Your challenge is to fill in the blanks above with code referring to previously calculated values (smaller n). The speed is vastly improved at the cost of storing the million definitions of CollatzLength[n] for specific n.

I added If[KeyExistsQ[collatzValues, n], collatzValues[n], collatzValues[n] = 1 + collatzLength[n/2]] between the brackets of Collatz...EvenQ, and If[KeyExistsQ[collatzValues, n], collatzValues[n], collatzValues[n] = 1 + collatzLength[n*3 + 1]] between the Brackets of OddQ, and added an association called collatzValues. Is that the kind of thing you meant? — globby, Dec 30 '14 at 23:41

Collatz optimization

3 Answers3

Linked

Related