9

2

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.

`NestList[]`

might make for a cleaner implementation here, I think. – J. M.'s ennui – 2015-05-31T02:38:12.737