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.

I want to draw a tree plot for Euler totient function for this question like the following:

enter image description here

I generate the EulerPhi for first 20 numbers into a list:

list = Map[# -> EulerPhi[#] &, Range[2, 20]]

Then I plot it using this:

TreePlot[list, Bottom, 1, VertexLabeling -> True,  DirectedEdges -> True ]

And the output:

enter image description here

But I want the layout of tree become like the above one so that numbers of form $2^n$ are centered and branches to the left or right. How can I do this?

By manually editing the graph the output looks like the following

enter image description here

Updated

I've managed to centralize the powers of $2$ but now the branches aren't placed well.

y = 0; coordinates = 
 Map[First[#] -> {0, y++} &, 
 Select[Prepend[list, 1 -> {0, 0}], IntegerQ[Log[2, First[#]]] &]]

{1 -> {0, 0}, 2 -> {0, 1}, 4 -> {0, 2}, 8 -> {0, 3}, 16 -> {0, 4}}

and using GraphPlot:

GraphPlot[list, VertexLabeling -> True, DirectedEdges -> True,
    VertexCoordinateRules -> coordinates]

enter image description here

Now, If the branches are placed upper than the root, then the result would be OK.

share|improve this question
add comment

3 Answers 3

Method 1: Semi-Automatic

My suggestion would be to use semi-automatic placement rules like

Needs["GraphUtilities`"]
n = 30;
list = Map[# -> EulerPhi[#] &, Range[2, n]];
RulesPow2 = Table[2^k -> {0, k}, {k, 0, 10}];
RulesOther = Table[k -> {Automatic, GraphDistance[list, k, 1]}, {k, Complement[Range[1, n], Table[2^k, {k, n}]]}]
vcr = Union[RulesPow2, RulesOther];
TreePlot[list, Top, 1, VertexLabeling -> True, DirectedEdges -> True, VertexCoordinateRules -> vcr, AspectRatio -> 0.6]

which produces

enter image description here

Sadly the semi-automatic placement does not work so well for some values with many long path branches, e.g. n=20.

Method 2: Roll your own Algorithm

Alternatively you can write some code to automatically calculate the coordinates for you, e.g.

Needs["GraphUtilities`"]; n = 136;
list = Map[# -> EulerPhi[#] &, Range[2, n]];
rlist = Map[#[[2]] -> #[[1]] &, list];
Pow2 = Table[2^k, {k, 0, Log[2, n]}];
vcr = {}; d = Table[0, {k, n}];
DepthFirstScan[Graph[rlist], 1, "PrevisitVertex" -> Function[
vcr = Append[vcr,
  If[MemberQ[Pow2, #], # -> {0, Log[2, #]}, 
     # -> {dd = GraphDistance[list, #, 1]; 
     d[[dd]] = Max[d[[dd]], ((# /. list) /. vcr)[[1]]] + 1; 
     d[[dd]], dd}]]]];
TreePlot[list, Top, 1, VertexLabeling -> True, DirectedEdges -> True, VertexCoordinateRules -> vcr, AspectRatio -> 0.6]

You can play with this any way you like, e.g. adjust

DepthFirstScan[Graph[rlist], 1, "PrevisitVertex" -> Function[
vcr = Append[vcr,
  If[MemberQ[Pow2, #], # -> {0, Log[2, #]}, 
       # -> {dd = GraphDistance[list, #, 1]; 
           d[[dd]] = Max[d, ((# /. list) /. vcr)[[1]]] + 1;
           d[[dd]], dd - 0.2}]]]];

The latter one should give enter image description here

share|improve this answer
add comment

If you are willing to sketch out how you want the graph to look, the following may be of interest. But I warn that it requires some manual input.

Imagine you sketch out something like this:

layout

So you know you are dealing with a grid with 6 levels, 7 cols). Assuming there are no internal gaps in the grid, you could tell MMA where you want vertices placed, going column by column.

The following,

layout = {{6, {20, 15, 5, 3}}, {6, {17, 16, 8, 4, 2, 1}}, {6, {11, 10,
  12, 6}}, {5, {13, 18}}, {5, {19, 7}}, {4, {9}}, {4, {14}}};

would be understood as meaning that the leftmost column begins as the highest level (6), and, reading downwards, should place the numbers 20, 15, 5, 3. And so forth. The following will assign coordinates to each vertex.

g[lis_]:=Module[{pos=0,f}, 
   f[{c_,r_,ns_}]:=Module[{pos=r},#-> {c,pos--}&/@ns];
   Flatten[f[Prepend[#, pos++]]&/@lis,1]]

Here are the original edges:

edges = {2 -> 1, 3 -> 2, 4 -> 2, 5 -> 4, 6 -> 2, 7 -> 6, 8 -> 4, 
  9 -> 6, 10 -> 4, 11 -> 10, 12 -> 4, 13 -> 12, 14 -> 6, 15 -> 8, 
  16 -> 8, 17 -> 16, 18 -> 6, 19 -> 18, 20 -> 8};

This gives the plot shown above.

Graph[edges,DirectedEdges -> True, VertexCoordinates -> g[layout],
ImagePadding -> 20,GraphStyle -> "VintageDiagram"]

So does this.

GraphPlot[edges, VertexLabeling -> True,DirectedEdges -> True, 
VertexCoordinateRules -> g[layout]]
share|improve this answer
    
Thanks @David, the manual input is possible for small values but as I wrote in the question I'm going to generate the plot for custom n maybe as large as 1000 so manual input would be impossible –  Mohsen Afshin Dec 5 '12 at 20:18
    
In principle, this would be possible, but it would require more time than I have available at the moment. –  David Carraher Dec 5 '12 at 20:49
add comment

Update: It turns out to be easier to construct your own vertex coordinates than trying to adjust the coordinates produced by built-in options.

 vrtxLst = {1, 2, 3, 4, 6, 5, 8, 12, 18, "{7,9,14}",
       15, 16, 10, 13, 19, 20, 17, 11};
 edgeLst = {2 -> 1, 3 -> 2, 4 -> 2, 5 -> 4, 6 -> 2, "{7,9,14}" -> 6,  8 -> 4, 
   10 -> 4,  11 -> 10, 12 -> 4, 13 -> 12, 15 -> 8, 16 -> 8, 17 -> 16,
   18 -> 6,  19 -> 18, 20 -> 8};
 alignedKPartiteCoords[layersizes_List, offsett_List] :=
    Flatten[Table[N[{i - 1, j - 1}], {j, Length[layersizes]},
       {i, 1 - offsett[[j]], layersizes[[j]] - offsett[[j]]}], 1];
 layersizes = {1, 1, 3, 5, 5, 3};
 offsets = {0, 0, 1, 1, 1, 1};
 options = Sequence[ImageSize -> 350, 
    VertexStyle -> Directive[EdgeForm[None], White], VertexSize -> 0.5`, 
    VertexLabels -> Placed["Name", {1/2, 1/2}],
    VertexLabelStyle -> Directive[12, RGBColor[1, 0, 0], Bold, Italic],
    VertexCoordinates -> alignedKPartiteCoords[layersizes, offsets]];
 Graph[vrtxLst, edgeLst, options]

enter image description here


Original post:

In version 9, you can use Graph with GraphLayout option set to {"MultipartiteEmbedding", "VertexPartition" -> {1, 1, 3, 7, 5, 3}}.

First manually re-ordered the vertex list to match the ordering in your first image:

  vl = {1, 2, 3, 4, 6, 5, 8, 12, 18, 7, 9, 14, 15, 16, 10, 13, 19, 20, 17, 11};
  grph1=Graph[vl, list, VertexLabels -> "Name", ImagePadding -> 10,
   GraphLayout -> {"MultipartiteEmbedding", "VertexPartition" -> {1, 1, 3, 7, 5, 3}}]

enter image description here

share|improve this answer
2  
This doesn't seem to answer the question. One of requirements is that nodes of the form 2^n form the central spine of the tree. –  m_goldberg Dec 5 '12 at 14:25
add comment

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.