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

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: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.

Fred Kline

Posted 2015-05-31T01:53:41.127

Reputation: 2 226

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

Answers

8

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

Dr. belisarius

Posted 2015-05-31T01:53:41.127

Reputation: 112 848

"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[].) – J. M.'s ennui – 2015-06-01T23:52:33.880

Still computer-less, unfortunately, but let me run through my scratch paper again, and I'll get back to you with a sketch. – J. M.'s ennui – 2015-06-02T00:59:46.060

@FredKline I posted a far better version that doesn't need a separated logic for the last element – Dr. belisarius – 2015-06-02T03:07:12.833

@Guesswhoitis. there you've it :) – Dr. belisarius – 2015-06-02T05:01:00.890

1Ah, that's more or less what I had in my paper. Thanks for following through, and I'm sorry I can't upvote again. – J. M.'s ennui – 2015-06-02T05:16:20.180

I like your answer, but for my paper I have to describe it from a different perspective which is why I posted the temporary answer. Let me know if you see anything that is awry. I'll delete it in a few days. Thanks for everything. This goes for @Guesswhoitis., too. – Fred Kline – 2015-06-02T07:23:09.840

@FredKline Perhaps ${(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 }$ ? – Dr. belisarius – 2015-06-02T13:35:47.617

where $f$ is nextSeq[n_] in the code above – Dr. belisarius – 2015-06-02T13:36:37.840

I like it. My new version is based the prism I use in my proofs. So, I think I will be using both methods for the graphing part of the paper. Should I delete the temporary answer now? – Fred Kline – 2015-06-02T14:24:14.773

@FredKline Oh, I don't understand your geometric visualization, so I can't evaluate how significant is your answer. Sorry, it's up to you :) – Dr. belisarius – 2015-06-02T14:32:36.873