## Intelligent vertex placement in large tree graphs

5

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: This is fine, and easily legible. However, if I create the analogous graph for the first 27 integers, I get: 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?

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? – alancalvitti – 2014-12-23T15:39:21.697

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.

– None – 2014-12-23T19:47:04.600

5

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,
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[
center +
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, 