Trying to visualize the Collatz conjecture

36

31

I happen to have this collatz

collatz[x_, y_] := If[x == 3*y || x == 2*y + 1 || y == 3*x || y == 2*x + 2, 2, 0]

So i want a visual 3D adjacency graph of my collatz but it wont display anything where am i wrong?

This is the code but i know am missing something but have no idea.

GraphPlot3D[collatz[#1, #2] &, {40, 40}]

but gives me Error.

Madona Syombua

Posted 2015-06-11T21:31:11.960

Reputation: 475

1Your last line has too many brackets, and you give GraphPlot3D two arguments even though it only accepts one. Just to mention two problems. – C. E. – 2015-06-11T21:39:12.477

1If this is supposed to be related to the collatz conjecture your implementation is way off. It doesn't do anything remotely like that. I also don't understand why you show us the Array function as it doesn't seem to be connected to the line above at all. – Sjoerd C. de Vries – 2015-06-11T22:04:12.460

Related: Collatz Tools

– dionys – 2015-06-12T07:54:10.590

many more collatz visualization strategies & analysis algorithms here & hope to hear more from anyone in [chat]

– vzn – 2015-06-12T16:26:24.437

1@vzn I have included a link to your blog in my answer since it contains many good links. – halirutan – 2015-06-12T17:09:50.730

3I'm sorry, this is really bothering me -- there's no such thing as "a collatz". Lothar Collatz is the name of the person who posed the Collatz conjecture. What you have there is a function, and you are asking to visualize the adjacency graph of your function. (Which leads to another problem: functions don't have adjacency graphs.) – None – 2015-12-03T04:54:41.233

Answers

41

This is the Collatz function I know:

Collatz[1] := {1}
Collatz[n_Integer]  := Prepend[Collatz[3 n + 1], n] /; OddQ[n] && n > 0
Collatz[n_Integer] := Prepend[Collatz[n/2], n] /; EvenQ[n] && n > 0

Generating a graph from this is easy:

Graph[(DirectedEdge @@@ Partition[Collatz[#], 2, 1]) & /@ Range[500] // Flatten // Union, 
 EdgeShapeFunction -> GraphElementData[{"Arrow", "ArrowSize" -> .005}], 
 GraphLayout -> "LayeredDrawing"]

Mathematica graphics

or with a different layout and with labeling:

Graph[(DirectedEdge @@@ Partition[Collatz[#], 2, 1]) & /@ Range[100] //
    Flatten // Union, GraphLayout -> "RadialEmbedding", 
 VertexLabels -> "Name"]

Mathematica graphics

A very fast version using memoization:

Collatz[1] := {1}
Collatz[n_Integer] := Collatz[n] = Prepend[Collatz[3 n + 1], n] /; OddQ[n] && n > 0
Collatz[n_Integer] := Collatz[n] = Prepend[Collatz[n/2], n] /; EvenQ[n] && n > 0

For a range of the first 5000 integers this gives a speedup of about a factor of 250. You might want to do a ClearAll[Collatz] afterwards to cleanup memory from all the stored chains.

Sjoerd C. de Vries

Posted 2015-06-11T21:31:11.960

Reputation: 63 549

If we don't care of performance, v10.2 allows plotting these graphs with NestGraph[Piecewise[{{1, # == 1}, {3 # + 1, OddQ@#}}, #/2] &, Range@25, 100, VertexLabels -> "Name", GraphLayout -> "RadialDrawing"]. NestGraph doesn't understand an end condition, so 100 steps is taken for every input. With an end condition this would be quite nice! – kirma – 2015-11-17T19:11:33.800

According to your first graph, where is actually the integer 1? – Adam – 2016-03-27T22:45:36.807

74

If you want to make several sequences of the Collatz function for turning it into a graph, you probably want to memorize, which parts you already calculated. What we try to do is to create a graph like this (image from xkcd):

Reference link

When we would calculate the whole chain for each number until it (hopefully) reaches the end sequence 8,4,1 we do a lot of work over and over again. Therefore, we want an algorithm that when calculating 24 stops at 10 if this chain has already be calculated.

A moderately understandable solution is to use a Module that contains a function which is used as memory to store, whether a numbers was already seen. Additionally, we use a Internal`Bag to store all the different chains. The following function takes a list of positive numbers and calculates the Collatz-sequence for each number. It stops each sequence, when it meets a number that has already be seen:

CollatzSequence[list_] := Module[{memory, tmp, chain, result = Internal`Bag[]},

  memory[1] = False;
  memory[n_] := (memory[n] = False; True);

  Do[
   chain = Internal`Bag[];
   tmp = l;
   While[memory[tmp],
    Internal`StuffBag[chain, tmp];
    tmp = If[EvenQ[tmp], tmp/2, 3 tmp + 1];
    ];
   Internal`StuffBag[chain, tmp];
   Internal`StuffBag[result, chain],
   {l, list}];
  Internal`BagPart[#, All] & /@ Internal`BagPart[result, All]
]

CollatzSequence[{10, 11, 12}]
(* {{10, 5, 16, 8, 4, 2, 1}, {11, 34, 17, 52, 26, 13, 40, 20, 
  10}, {12, 6, 3, 10}} *)

This can now easily be used to create a Graph. It works even for a very large number of chains like say 50000. The only thing you have to do is to turn the list of numbers into list of edges:

Graph[
 Flatten[(Rule @@@ Partition[#, 2, 1]) & /@ 
   CollatzSequence[Range[50000]]],
 PerformanceGoal -> "Speed", 
 GraphLayout -> {"PackingLayout" -> "ClosestPacking"}, 
 VertexStyle -> Opacity[0.2, RGBColor[44/51, 10/51, 47/255]], 
 EdgeStyle -> RGBColor[38/255, 139/255, 14/17]]

Mathematica graphics


Another very nice way to visualize Collatz-sequences is to draw them as path which makes left/right turns depending on the whether the number is odd or even. I got inspired by a reddit post and wrote my own version that uses this color scheme. The results look stunningly beautiful

Mathematica graphics

Only for reference, let me give you my uncleaned code for a small Manipulate that lets you change everything live.

SetAttributes[Collatz, {Listable}];
Collatz[n_, e_, a_, f_] := Module[{nn = n, bag = Internal`Bag[]},
   While[nn =!= 1, Internal`StuffBag[bag, nn];
    nn = If[EvenQ[nn], nn/2, 3 nn + 1]
    ];
   Internal`StuffBag[bag, nn];
   With[{seq = Reverse[Internal`BagPart[bag, All]]}, 
    AnglePath[Transpose[{seq/(1 + seq^e), a*(f - 2 Mod[seq, 2])}]]]];

astroIntensity[l_, s_, r_, h_, g_] := 
  With[{psi = 2 Pi (s/3 + r l), a = h l^g (1 - l^g)/2}, 
   l^g + a*{{-0.14861, 1.78277}, {-0.29227, -0.90649}, {1.97294, 
        0.0}}.{Cos[psi], Sin[psi]}];

Manipulate[
 DynamicModule[{seq},
  seq = ControlActive[Collatz[Range[5000, 5020], e, a, f], 
    Collatz[RandomInteger[1000000, {n}], e, a, f]];
  Graphics[{Opacity[o], Thickness[ControlActive[0.01, 0.003]], 
    Line[seq, 
     VertexColors -> (Table[
          astroIntensity[l, s, r, h, g], {l, 0, 1, 
           1/(Length[#] - 1)}] & /@ seq)]}, ImageSize -> 500]
  ]
 , "Colors", {{s, 2.49}, 0, 3}, {{r, 0.76}, 0, 5}, {{h, 1.815}, 0, 
  2}, {{g, 1.3}, 0.1, 2}, {{o, 0.5}, 0.1, 1},
 Delimiter,
 "Structure",
 {{e, 1.3}, 0.9, 1.8},
 {{a, 0.19}, 0.1, 0.3},
 {{f, 0.7}, 0.1, 1.5},

 {n, 300, 5000, 1}
 ]

Many more Collatz visualization strategies and analysis algorithms can be found in this blog post of user vzn.

halirutan

Posted 2015-06-11T21:31:11.960

Reputation: 109 574

1+1 I think you forgot to post the line of code that gives Collatz a Listable attribute. – Chip Hurst – 2015-06-12T03:02:01.397

@ChipHurst Thanks for paying attention. Fixed. – halirutan – 2015-06-12T03:04:30.623

Stunning. Is AnglePath exclusive to Mathematica 1.1.0? I don't have it in 10.0.2. – shrx – 2015-06-12T09:45:23.123

@shrx, it's in 10.1, but it isn't too hard to use FoldList[] to implement it in earlier versions. – J. M.'s ennui – 2015-06-12T09:48:08.000

1@Guesswhoitis. True, I implemented it with anglePath[ri_, θi_] := FoldList[{#1[[1]] + #2[[1]] Cos[#2[[2]]], #1[[2]] + #2[[1]] Sin[#2[[2]]]} &, {0, 0}, Transpose[{ri, Accumulate@θi}]] and it works (after throwing out Transpose inside the built-in AnglePath in the definition of Collatz). – shrx – 2015-06-12T10:02:24.113

1

Reference for the drawing: https://xkcd.com/710/

– Carsten S – 2015-06-12T12:52:46.077

@CarstenSchultz Oh yes, I should have know but that's where I saw it. I included the original ref. – halirutan – 2015-06-12T14:49:35.370

+1. Interesting - I only saw this question and your answer now, but in my answer on memoization with pure functions I have used a pretty similar - although not quite the same - construct to store cached values (I did also use exactly the construct you used here, many times before, but the funny thing is that two rather similar approaches were published independently in a short period of time). – Leonid Shifrin – 2015-06-12T21:42:16.480

I like the picture where you have right/left pathes. Could you say where the node $1$ is? Is it in the middle? – Adam – 2016-03-30T18:17:06.880

wow, could I have a high res of the last image you posted? I would like to print this and hang it on a wall! – Honza – 2017-03-28T18:52:50.277

@Honza Do you have access to Mathematica 11.1? – halirutan – 2017-03-29T01:16:20.850

@halirutan unfortunatelly i dont – Honza – 2017-06-09T20:37:56.260