# Collatz optimization

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 Mathematica Chat
– vzn
Jun 12 '15 at 17:21

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

• Can you extend memoization for example to parametrized version collatz[a_,b_][n_] where {a,b} generalize {3,1}? Dec 31 '14 at 18:03
• Also, might as well divide 3*n + 1 by 2, saves redundant steps. 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 ;-). Jan 1 '15 at 12:14
• .... sorry the code is not shown very pretty, but readable ... Jan 1 '15 at 12:16
• some more detailed non-mathematica description of what this is doing (memoization? how so?) would be helpful.
– vzn
Aug 11 '15 at 20:51

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.

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? Dec 30 '14 at 23:41
• @globby Yes, looks good. Try it and see! Jan 4 '15 at 17:14