Collatz Conjecture in Mathematica

Question

I am new to Mathematica and am trying to understand patterns and rules. So I tried the following:

A = {1, 2, 3, 4}
A //. {x_?EvenQ -> x/2, x_?OddQ -> 3 x + 1}

This is based on: http://en.wikipedia.org/wiki/Collatz_conjecture

This is supposed to converge, but what I got is:

ReplaceRepeated::rrlim: Exiting after {1,2,3,4} scanned 65536 times. >>

Please help me understand my error in the pattern/rule.

Regards

Answer 1

The way you wrote this, it does not terminate, so it eg ends up alternating between 1 and 4, 2 etc. (all recursive descriptions must eventually bottom out somewhere, and your does not include a case to do that at n=1).

This works:

ClearAll[collatz];
collatz[1] = 1;
collatz[n_ /; EvenQ[n]] := collatz[n/2]
collatz[n_ /; OddQ[n]] := collatz[3 n + 1]

although it does not give a list of the intermediate results. A convenient way to get them is

ClearAll[collatz];
collatz[1] = 1;
collatz[n_ /; EvenQ[n]] := (Sow[n]; collatz[n/2])
collatz[n_ /; OddQ[n]] := (Sow[n]; collatz[3 n + 1])
runcoll[n_] := Last@Last@Reap[collatz[n]]

runcoll[115]
(*
-> {115, 346, 173, 520, 260, 130, 65, 196, 98, 49, 148, 74, 37, 112, 56,
28, 14, 7, 22, 11, 34, 17, 52, 26, 13, 40, 20, 10, 5, 16, 8, 4, 2, 1}
*)

or

colSeq[x_] := NestWhileList[
Which[
EvenQ[#], #/2,
True, 3*# + 1] &,
 x,
 # \[NotEqual] 1 &]

so that eg

colSeq[115]
(*
-> {115, 346, 173, 520, 260, 130, 65, 196, 98, 49, 148, 74, 37, 112, 56,
28, 14, 7, 22, 11, 34, 17, 52, 26, 13, 40, 20, 10, 5, 16, 8, 4, 2, 1}
*)

By the way the fastest approach I could come up with (I think I needed it for some project Euler problem) was something like

Clear@collatz;
collatz[1] := {1}
collatz[n_] := collatz[n] = If[
  EvenQ[n] && n > 0,
  {n}~Join~collatz[n/2],
  {n}~Join~collatz[3*n + 1]]

compare:

colSeq /@ Range[20000]; // Timing
(*
-> {6.87047, Null}
*)

while

Block[{$RecursionLimit = \[Infinity]},
  collatz /@ Range[20000];] // Timing
(*
-> {0.54443, Null}
*)

(we need to increase the recursion limit to get this to run correctly).

Answer 2

You got the recursive cases right, but you have no base case to terminate the recursion which leads to infinite recursion (or until Mathematica hits the pattern replacement limit). If you stop when you reach 1, it works as expected:

In[1]:= A = {1,2,3,4}
Out[1]= {1,2,3,4}

In[2]:= A //. {x_?EvenQ /; x>1 -> x/2, x_?OddQ /; x>1 -> 3 x+1}
Out[2]= {1,1,1,1}