Finding large Collatz Sequences, trying to improve speed

Question

Background: I am already very much in love with Mathematica but I am also a novice. So far I have only gathered experience in procedural programming in Python. Generally speaking I am trying to reimplement code that I have already written once in 'good' mathematica code using functional programming.

Problem: I am trying to explore the Collatz Sequences, more precisely I am trying to find large/long Collatz Sequences and I am very amazed at how easy this becomes to implement in Mathematica (I have done this once before in Python).

Here is my (working) solution which I try to optimize (if possible):

collatz[n_Integer ?OddQ] := 3 n + 1 
collatz[n_Integer ?EvenQ] := n / 2

Simply the definition of the collatz function, next of course I will use the NestWhileList function to only study the length of the smallest collatz sequences that terminate to 4,2,1 (by the conjecture they all do and then of course oscillate in that pattern)

collatzlength[n_Integer]:= Length@NestWhileList[collatz, n, # != 1 & ]

And my naive approach now would be to map these over a certain range like this:

Map[collatzlength, Range[1,2000]]

This code terminates in 0.288845 seconds on my machine, which is pretty good. Naivly to find very large Collatz Sequences I would take the Maximum of the above and increase the Range. Out of curiousity I computed

Max[Map[collatzlength, Range[1, 1'000'000]]

Which took 292 seconds on my machine (result is 525 by the way). I believe that is still a rather good time. I can vaguely imagine in my head what must be all computed in the background and considering all the recursion that result is I would say okay.

My question now would be if I could improve on that code, if possible in a way that a beginner could understand.

One thought I already had would be to slice up the Interval from 1 to 1 Million into disjoint subintervals in which Mathematica can do the computation fast and then take the Maximum over all such subintervals. I didn't have much luck implementing that idea yet but I am working on it, maybe there is a better solution however.

Answer 1

Defining the "Collatz"-Function like you did is straight-forward, but in the sense of Mathematica not optimal. When computing the length of a Collatz-Sequence a lot of duplicate calculations are done. So defining:

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

prevents Mathematica from doing duplicate evaluation. This is more efficient than defining

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

You find a corresponding post here. The length of the sequence you´ll get via

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

and

collatzLength[n_] := Length@collatzSequence[n]

Then

In[222]:= collatzLength[3^300] // Timing

Out[222]= {0.004165, 2904}

If you are looking for long sequences you can try p^n for primes p as a starting number. Doing this for p=3, 5, 7 you´ll get interesting sequence lengths (here for p=3,5,7 and n from 1 to 500.

Answer 2

As suggested by @mgamer you do need memoizing. If all you care about is the flight length then you do not need the actual function, just recursively define

collatzLength[1] = 0;
collatzLength[n_Integer] := collatzLength[n] = 
  1 + If[EvenQ[n], collatzLength[n/2], collatzLength[3*n + 1]]

Timing[Max[Map[collatzLength, Range[1, 1000000]]]]

returns 15.070896 sec / 524 on my 2011 macbook pro.

Note that directly evaluating collatzLength[3^300] // Timing requires increasing the recursion limit whereas mapping to a large range does not, this again due to memoization.