# Need tips on improving this directed graph

First we define a function that returns the least odd prime factor.

lopf[n_] := FactorInteger[n][[2, 1]]


Then we craft a routine that performs the 3x+1 steps using only primes

t = {};
z = 4;
While[z < 501,
y = Prime[z++];
prev = y;
u = {};
x = y;
While[x >= y,
prev = x;
x = lopf[3 x + 1];
u = AppendTo[u, {DirectedEdge[prev, x]}];
t = AppendTo[t, u];
]
]
t = Union[Flatten[t]];


Then we graph it

Graph[t] How can we structure this graph in a more civilized manner? I would like to have the first 5 primes {7,11,17,13,5} placed vertically down the center of a .pdf page and the remaining primes clustered about them.

Also, Is there a way to use a rollover to identify a prime represented by a dot? This would be handy within an interactive document.

  g = Graph[Tooltip /@ t,
VertexSize ->
Append[Thread[{5, 7, 11, 13, 17} -> {"Scaled", .01}, List, 1], {"Scaled", .005}],
VertexStyle -> Thread[{5, 7, 11, 13, 17} -> Red],
VertexLabels -> Placed["Name", Tooltip],
GraphLayout -> "RadialDrawing", ImageSize -> 700] //  Rotate[#, 90 Degree] &


gives Does not quite line up the nodes for the first five primes in the list, but it is a cheap alternative to building a custom layout from scratch using VertexCoordinates.

EDIT: If the size of graph is reduced, one can use GraphPlot and its options to vertically line up the first five nodes. For this to work, I had to reduce the number of nodes to plot:

 tX = {}; z = 4; While[z < 240, y = Prime[z++]; prev = y; u = {};  x = y;
While[x >= y, prev = x; x = lopf[3 x + 1];
u = AppendTo[u, {DirectedEdge[prev, x]}]; tX = AppendTo[tX, u];]];
tX = Union[Flatten[tX]];
tX2 = tX /. DirectedEdge[x_, y_] :> Rule[x, y];


With this dataset

 GraphPlot[tX2, PlotStyle -> Gray,
VertexRenderingFunction -> Function[{p, l},
Tooltip[{If[MemberQ[{5, 7, 11, 13, 17}, l],
Sequence @@ {Red, PointSize[.015]},
Sequence @@ {Blue, PointSize[.008]}], Point[p]}, Text[l]]],
VertexCoordinateRules ->  Thread[{5, 7, 11, 13, 17} -> {0, Automatic}, List, 1],
DirectedEdges -> True,
ImageSize -> 400]


gives EDIT 2: Aligning the first 5 nodes in graph g above:

coordlist = PropertyValue[{g, #}, VertexCoordinates] & /@ VertexList[g][[;; 5]];
coordlist[[All, 2]] = 4;
Fold[SetProperty[{#1, #2},
VertexCoordinates -> coordlist[[VertexIndex[g, #2]]]] &, g,
VertexList[g][[;; 5]]]
// Rotate[#, 270 Degree] & • I think the limitation on the number of nodes in GraphPlot is too restrictive for my needs. The first graph rotated 270 to place the 5 on the bottom of the page is perfect. May 1 '12 at 1:09