10
$\begingroup$

I want to construct a binomial tree using TreePlot but have troubles with the alignment. The code TreePlot[{1 -> 2, 1 -> 3, 2 -> 4, 2 -> 5, 3 -> 5, 3 -> 6}, Left, 1, DirectedEdges -> True, VertexLabeling -> True] produces the following image:treeplot

How can I make something like this?:

desiredoutput

EDIT: The image MMA produces: http://imgur.com/ygvqJ6D. The image I would like to have: http://imgur.com/NpJuHFm.

$\endgroup$
  • $\begingroup$ @belisariushassettled, I added links to the images. $\endgroup$ – Skumin Nov 23 '15 at 21:24
  • $\begingroup$ There is NestedSymmetricSubdivision function in ref / Traingle just before Properties & Relations section. One could use it for VertexCoordinates. $\endgroup$ – Kuba Nov 24 '15 at 7:12
  • $\begingroup$ related q/a: Drawing the schematic diagram of algorithm $\endgroup$ – kglr Aug 18 '17 at 15:58
11
$\begingroup$

The idea is simple: we take the graph made by TreePlot and we change (the coordinates of) the points for the graph nodes into more regularly spaced points.

The solution below attempts to be somewhat robust.

  1. The arguments and options taken by TreePlot can be used.

  2. There is a check for is it possible the symmetric layout of the binary tree be done in such a way that the symmetricity is preserved for the tree sub-branches. See the last plot for which this is not the case.

I hope the code below is easy enough to follow.

Clear[MakeSymmetricTreePlot]
MakeSymmetricTreePlot[graphRules_, additionalArgs___, opts : OptionsPattern[]] := 
  Block[{pos, gr, points, brect, pointGroups, newxs, newys, newPoints, 
         prules, xi = 1, yi = 2},
   If[Length[{additionalArgs}] == 0, pos = Top, pos = First@{additionalArgs}];
   gr = TreePlot[graphRules, additionalArgs, opts];
   points = Cases[gr, GraphicsComplex[p_, ___] :> p, Infinity][[1]];
   (*Making the new points.*)
   If[pos === Top || pos === Bottom, {xi, yi} = {yi, xi}];
   brect = RegionBounds[Point[points]];
   pointGroups = SortBy[GroupBy[points, Round[#[[xi]], 10^-8] &],Length];
   newxs = Keys[pointGroups];
   If[And @@ 
     Map[#[[1]] + 1 == #[[2]] &, 
      Partition[Length /@ Values[pointGroups], 2, 1]],
    (*We can do a locally symmetric layout.*)
    newys = Reverse@
      NestList[
       If[Length[#] == 2, {Mean[#]}, Mean /@ Partition[#, 2, 1]] &, 
       Values[pointGroups][[-1]][[All, yi]], 
       Length[pointGroups] - 1],
    (*ELSE*)
    newys = Map[
       Apply[Range, 
          Append[brect[[yi]], 
           Abs[Subtract @@ brect[[yi]]]/(# + 1)]][[2 ;; -2]] &, 
       Length /@ Values[pointGroups]];
   ];
   If[pos === Top || pos === Bottom,
    newPoints = 
     MapThread[Outer[List, #2, {#1}][[All, 1]] &, {newxs, newys}],
    newPoints = MapThread[Outer[List, {#1}, #2][[1]] &, {newxs, newys}]
   ];
   (*Make rules from old to new points and replace them in the graph graphics.*)
   prules = 
    Flatten@MapThread[
      Thread[#1 -> #2] &, {Values[pointGroups], newPoints}];
   gr /. prules
 ];

Some examples follow.

graphRules = {1 -> 2, 1 -> 3, 2 -> 4, 2 -> 5, 3 -> 5, 3 -> 6};
MakeSymmetricTreePlot[graphRules, Left, 1, DirectedEdges -> True, VertexLabeling -> True]

enter image description here

graphRules = {1 -> 2, 1 -> 3, 2 -> 4, 2 -> 5, 3 -> 5, 3 -> 6, 4 -> 7, 
   4 -> 8, 5 -> 8, 5 -> 9, 6 -> 9, 6 -> 10};
MakeSymmetricTreePlot[graphRules, Right, DirectedEdges -> True, 
 VertexLabeling -> True]

enter image description here

graphRules = {1 -> 2, 1 -> 3, 2 -> 4, 2 -> 5, 3 -> 5, 3 -> 6, 4 -> 7, 
   4 -> 8, 5 -> 9, 5 -> 10, 6 -> 11, 6 -> 12};
MakeSymmetricTreePlot[graphRules, DirectedEdges -> True, 
 VertexLabeling -> True]

enter image description here

$\endgroup$
  • $\begingroup$ The code indeed is easy to follow, thank you! $\endgroup$ – Skumin Nov 24 '15 at 9:52
  • $\begingroup$ @Skumin Great then, I am glad it is working out. $\endgroup$ – Anton Antonov Nov 24 '15 at 14:26
3
$\begingroup$

You can use the built-in graph layout "MultipartiteEmbedding" as

GraphLayout -> {"MultipartiteEmbedding", "VertexPartition" -> Range[n]}

where n is the number of layers in the tree.

edges1 = {1 -> 2, 1 -> 3, 2 -> 4, 2 -> 5, 3 -> 5, 3 -> 6};
Graph[Sort @ VertexList[edges1], edges1, GraphStyle -> "VintageDiagram", 
 GraphLayout -> {"MultipartiteEmbedding", "VertexPartition" -> Range[3]}]

enter image description here

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

g = Graph[Sort @ VertexList[edges2], edges2, GraphStyle -> "VintageDiagram", 
 GraphLayout -> {"MultipartiteEmbedding", "VertexPartition" -> Range[6]}]

enter image description here

To change the orientation, you can transform the vertex coordinates:

embedding = GraphEmbedding[g];
Row[SetProperty[g, {AspectRation -> 1,
 VertexCoordinates -> (# /@ embedding)] & /@ 
   {ReflectionTransform[{Max[embedding[[All, 2]]], 0}], 
    RotationTransform[-Pi/2], 
    RotationTransform[Pi/2]}}]

enter image description here

$\endgroup$
  • $\begingroup$ Nice, simple, and easy-to-read! $\endgroup$ – Skumin Nov 27 '17 at 9:24

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.