5
$\begingroup$

This question about graph layout is fairly general, but can be illustrated in the case of the Collatz Conjecture. Collatz created the following function over integers greater than 1: If the integer n is even, then divide it by 2; otherwise multiply it by 3 and add 1. He conjectured that if his function is iterated, it will eventually yield 1, regardless of the starting integer. I would like to represent the transitions naturally in a directed graph.

myCollatz[n_: Integer] := If[EvenQ[n], n/2, 3 n + 1];

allPaths = Table[NestWhileList[myCollatz, j, # != 1 &], {j, 26}];

for all starting integers from j = 1 to 26.

myEdgeMaker[x_: List] := Table[Rule[x[[i]], x[[i + 1]]], {i, Length[x] - 1}];

The relevant vertexes are:

relevantVertexes = 
 First@ WeaklyConnectedComponents@
   Graph[Range[Max[allPaths]], 
    DeleteDuplicates@(Flatten@(myEdgeMaker /@ allPaths))]

The graph of transitions is then:

Graph[relevantVertexes, 
 DeleteDuplicates@(Flatten@(myEdgeMaker /@ allPaths)),
 VertexLabels -> "Name",
 GraphLayout -> {"LayeredEmbedding", "RootVertex" -> 1, 
   "Orientation" -> Right},
 ImageSize -> 1000]

yielding a graph such as this:

enter image description here

This is fine, and easily legible. However, if I create the analogous graph for the first 27 integers, I get:

enter image description here

which is of course not legible.

I'd like to place the vertexes automatically such that long linear chains are compressed, while preserving the legibility of the topological properties of the graph. I've tried several of the GraphLayout embeddings, but none quite suffice. The simplest would be an automatic method for collapsing long linear chains, while preserving other structures.

Any suggestions?

$\endgroup$
  • $\begingroup$ Graph layout is difficult in general - there are multiple books and methods for various classes of graphs. The Collatz predecessor graph is a tree, which gives more freedom to embed in the plane (eg, spread out radially) but even so label placement is the hurdle. What are the options for the long linear path in n=27 besides Rotate labels and space out appropriately? $\endgroup$ – alancalvitti Dec 23 '14 at 15:39
  • $\begingroup$ You could use the first part of this answer to find all the linear chains in the graph. I haven't thought yet about how to collapse them. $\endgroup$ – Rahul Dec 23 '14 at 19:47
5
$\begingroup$

Here's might be one way to do it. The basic idea is:

  1. Compute vertex coordinate using radial embedding (possibly layered embedding).
  2. Find the longest chain.
  3. Get the center and bounding box of decent set of points.
  4. wrap the longest chain around bounding box.

the sample code is

myCollatz[n_: Integer] := If[EvenQ[n], n/2, 3 n + 1];

myEdgeMaker[x_: List] := 
  Table[Rule[x[[i]], x[[i + 1]]], {i, Length[x] - 1}];

collatzGraph[n_, opt : OptionsPattern[]] :=     
 Block[{allPaths, edges, g, lpath, dis, indices, vcoord, lpc, 
   minmax, center, rad, alpha, ncoord,},
  allPaths = Table[NestWhileList[myCollatz, j, # != 1 &], {j, n}];
  edges = DeleteDuplicates@(Flatten@(myEdgeMaker /@ allPaths));
  g = Graph[edges, opt, GraphLayout -> {"RadialEmbedding"}];
  lpath = 
   First[Reverse[
     SortBy[FindShortestPath[g, #, 1] & /@ 
       VertexList[g, x_ /; VertexInDegree[g, x] == 0], Length]]];
  dis = Position[lpath, x_ /; VertexInDegree[g, x] > 1, 1, 1][[1, 
     1]];
  indices = VertexIndex[g, #] & /@ Reverse[lpath[[;; dis]]];
  vcoord = GraphEmbedding[g];
  lpc = vcoord[[indices]];
  minmax = {Min[#], Max[#]} & /@ Transpose[Complement[vcoord, lpc]];
  center = ((#2 - #1)/2 + #1) & @@@ minmax;
  rad = Max[#2 - #1 & @@@ minmax] .8;
  alpha = 0; 
  ncoord = Table[
    If[EuclideanDistance[center, i] <= rad, i, rad += .1; 
     center + 
      rad  Normalize[
        RotationTransform[alpha += Pi/(Length[lpc]/3), center][i] - 
         center]], {i, lpc}];
  vcoord[[indices]] = ncoord;
  SetProperty[g, VertexCoordinates -> vcoord]
  ]

code can be further optimized and tweaked for purpose..

example:

collatzGraph[27, VertexLabels -> Placed["Name", Center], 
 ImageSize -> 800, VertexShapeFunction -> "Capsule", VertexSize -> 1, 
 VertexStyle -> Directive[EdgeForm[Black], White], 
 VertexLabelStyle -> 7, 
 EdgeStyle -> Directive[Black, Arrowheads[{{.008, .7}}]]]

enter image description here

$\endgroup$
  • $\begingroup$ I like the general concept very much: wrap long linear sections in a spiral. It would be very interesting to see how the graph layout would apply when there are several long linear segments, but clearly the general approach is applicable. Thanks so much! $\endgroup$ – David G. Stork Dec 24 '14 at 17:47

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.