7
$\begingroup$

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.

$\endgroup$
3
  • $\begingroup$ Welcome to Mathematica.SE! I suggest that: 1) You take the introductory Tour now! 2) When you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge. Also, please remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign! 3) As you receive help, try to give it too, by answering questions in your area of expertise. $\endgroup$
    – bbgodfrey
    Mar 14, 2015 at 17:20
  • $\begingroup$ This is what you need: mathematica.stackexchange.com/questions/29553/… The key trick in speeding up Collatz sequence computation is storing sequences for a given $n$. Then if a sequence starting at $m != n$ ever hits $n$, the rest of the sequence is known. In fact, once can produce a tree structure for the Collatz sequences, that has one final stalk of $\{ 32, 16, 8, 4, 2, 1 \}$, for instance. $\endgroup$ Mar 14, 2015 at 17:58
  • 2
    $\begingroup$ there is a remarkable way to generate sequences with very long "glides" or whatever other characteristics, basically by just searching/ setting higher "msbs" in the current best trajectories. this is as a subroutine in this post & there is a lot of other code/ analysis related to that in other posts. hope to hear more from anyone on collatz in Mathematica Chat $\endgroup$
    – vzn
    Jun 12, 2015 at 17:19

2 Answers 2

12
$\begingroup$

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.

enter image description here

$\endgroup$
1
  • $\begingroup$ attempting to replicate this outside of mathematica. this example seems to be about built-in memoization. is that global memoization across different calls? would the graph be the same if it were done in the order 7, 5, 3 instead? $\endgroup$
    – vzn
    Aug 11, 2015 at 20:53
6
$\begingroup$

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.

$\endgroup$
2
  • 1
    $\begingroup$ It seems slightly faster, and in my opinion more readable, to catch the n=1 case with a separate pattern rather than testing for n==1, f[1] = 1; f[n_] := f[n] = 1 + f[If[EvenQ[n], n/2, 3 n + 1]] $\endgroup$ Mar 14, 2015 at 23:04
  • $\begingroup$ Thanks @Simon, I added you suggestion. The code is more readable and the timing marginally improved (18 down to 15 sec). $\endgroup$
    – A.G.
    Mar 14, 2015 at 23:12

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.