Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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]

Mathematica graphics

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.

share|improve this question

1 Answer 1

up vote 17 down vote accepted
  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

enter image description here

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

enter image description here

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] &

enter image description here

share|improve this answer
    
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. –  Fred Kline May 1 '12 at 1:09

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.