# 3x+1 on arithmetic chains, tree pruning and NestList

Given the following function Collatz:

Collatz[Subscript[m_, d_] /;  EvenQ[m] && EvenQ[d]] := Subscript[m/2, d/2]
Collatz[Subscript[m_, d_] /;  OddQ[m] && EvenQ[d]] := Subscript[3 m + 1, 3 d]
Collatz[Subscript[m_, d_] /;  OddQ[d]] :=
Collatz /@ {Subscript[m, 2 d], Subscript[m + d, 2 d]}


The immediate question that crops up, once Collatz is made Listable to handle the branching - is to manage the trajectories. This includes identifying and filtering cycles (ie, periodic orbits) from the transition graph.

The first 5 iterates given the initial state Subscript[1,1] (the chain of natural numbers 1,2,3...) is:

Column@ NestList[Collatz,Subscript[1, 1],5]

(* Out[1]= Subscript[1, 1]
{Subscript[1, 2],Subscript[2, 2]}
{Subscript[4, 6],Subscript[1, 1]}
{Subscript[2, 3],{Subscript[1, 2],Subscript[2, 2]}}
{{Subscript[2, 6],Subscript[5, 6]},{Subscript[4, 6],Subscript[1, 1]}}
{{Subscript[1, 3],Subscript[16, 18]},{Subscript[2, 3],{Subscript[1, 2],Subscript[2, 2]}}} *)


Any suggestions for functional approaches to filter out cycles, in other words, states that are repeated in the output of NestList but are not observable at the level of a single call to Collatz? In the above simulation, Subscript[1,1] should be filtered out after the 2nd iteration.

Recall, vertices of the transition graph are the chains Subscript[n,d] while the arcs link inputs of Collatz with its output chain(s).

-
Did you try NestWhileList[f,expr,test,All]? –  belisarius Apr 7 '12 at 2:56
Isn't this an unusual way of stating the Collatz conjecture? I recall that it only has one parameter. What's the subscript doing here? –  Sjoerd C. de Vries Apr 8 '12 at 19:53
@Sjoerd If Eddington could get new physical constants out of thin air, I don't believe adding a few constants to Collatz would hurt much ... –  belisarius Apr 9 '12 at 6:11
@Sjoerd, it's the same dynamics but in a modular arithmetic coordinate system. There are no (free) parameters in the 3x+1 problem. However, generalizations are considered. Only 2 of the fundamental open conjectures listed in Lagarias's book refer to 3x+1 itself. Conway proved that the limiting generalization of this class of problems is undecidable. –  alancalvitti Apr 10 '12 at 20:17
@belisarius, NestWhileList doesn't address the issue. It may of course be used to selectively terminate the computation. However, what is needed here is tree pruning at each iteration, otherwise, redundant states accumulate (again, in the arithmetic chain state space) –  alancalvitti Apr 10 '12 at 20:22

I think you can get the non repeated terminal symbols after round N by using the following (not optimized)

Collatz[Null] = Null;
Collatz[Subscript[m_, d_] /; EvenQ[m] && EvenQ[d]] :=
Collatz[Subscript[m, d]] = check@Subscript[m/2, d/2];

Collatz[Subscript[m_, d_] /; OddQ[m] && EvenQ[d]] :=
Collatz[Subscript[m, d]] = check@Subscript[3 m + 1, 3 d];

Collatz[Subscript[m_, d_] /; OddQ[d]] :=
Collatz[Subscript[m, d]] =
Collatz /@ {check@Subscript[m, 2 d], check@Subscript[m + d, 2 d]};

Collatz1[x__] := (p = (DownValues@Collatz /.
HoldPattern[_[q_] :> _] :> q)[[2 ;; -4]]; Collatz[x])

check[t_] := If[Cases[p, t, Infinity] == {}, t, Null]

SetAttributes[Collatz, Listable];
SetAttributes[Collatz1, Listable];

NestList[Collatz1, Subscript[1, 1], 12][[-1, 1]]

-
Thanks for the effort but there seems no difference in behavior between Collatz and Collatz1 –  alancalvitti May 30 '12 at 21:02
@alancalvitti After more than one month I really don't remember –  belisarius May 30 '12 at 22:55