Possible improvements to this Syracuse (3x+1)/2 graph?

Question

This algorithm produces the Syracuse disjoint tree graph without any duplicates. No need for Union, For, and While. The function α is based on this OEIS sequence. The function β is a wrapper for IntegerExponent. Related math.SE question.

    α[n_] := 3 n - (5 + (-1)^n)/2  
    β[m_] := IntegerExponent[m, 2]  
    a = Table[Join[
                  {Table[x -> (x = (3 x + 1)/2), {β[(x = α[j]) + 1] - 1}]},
                  {x -> (3 x + 1)/2^β[3 x + 1]}
                  ],
             {j, 1, 150}];
    Graph[Flatten[a]]  

Fifteen sequences:, 150 sequences:

Edit It seems I was abusing the set-builder notation, so my question at math.SE will not parallel the Mathematica statements. So, this question remains: Is there any way to improve the Table expression? It was suggested that NestList[] might be the ticket.

Answer 1

You're setting x as a side-effect and that (I believe) makes your code difficult to follow. This one is equivalent using a "more functional" programing style.

As @Guesswhoitis suggested, NestList[] is your friend.

a[n_] := 3 n - (5 + (-1)^n)/2
b[m_] := IntegerExponent[m, 2]
nextSeq[n_] := (#/2^b@#) &[1 + 3 n]
full[j_] := NestList[nextSeq, a@j, b[a@j + 1]]
Graph[DirectedEdge @@@ Flatten[Partition[#, 2, 1] & /@ full /@ Range@15, 1]]

I don't know anything about set-builder notation, but perhaps the following is an approximation:

$$\{(f^k(a(j)), f^{k+1}(a(j))) \ | \ \{ k,j\} \in \mathbb{Z}\ \wedge\ \ 0\le\ k \le\ b(a(j)+1) - 1\ \wedge 0\le\ j \le\ n \}$$

($f$ is the nextSeq[ ] function in the above snippet)

GraphicsGrid@
 Partition[
   Graph[DirectedEdge @@@Flatten[Partition[#, 2, 1] &/@ full/@ Range@#,1]]&/@ Range@50, 
          10]