9
$\begingroup$

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:Fifteen sequences, 150 sequences: One hundred fifty 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.

$\endgroup$
8
$\begingroup$

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]]

Mathematica graphics

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]

Mathematica graphics

|improve this answer|||||
$\endgroup$
  • $\begingroup$ "setting x as a side-effect" - after all, that is how one would do Collatz in a procedural language. Thanks for showing OP the NestList[] route! (Tho, what I had in mind involved Partition[] as well as NestList[].) $\endgroup$ – J. M.'s technical difficulties Jun 1 '15 at 23:52
  • $\begingroup$ Still computer-less, unfortunately, but let me run through my scratch paper again, and I'll get back to you with a sketch. $\endgroup$ – J. M.'s technical difficulties Jun 2 '15 at 0:59
  • $\begingroup$ @FredKline I posted a far better version that doesn't need a separated logic for the last element $\endgroup$ – Dr. belisarius Jun 2 '15 at 3:07
  • $\begingroup$ @Guesswhoitis. there you've it :) $\endgroup$ – Dr. belisarius Jun 2 '15 at 5:01
  • 1
    $\begingroup$ Ah, that's more or less what I had in my paper. Thanks for following through, and I'm sorry I can't upvote again. $\endgroup$ – J. M.'s technical difficulties Jun 2 '15 at 5:16

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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