3
$\begingroup$

I'm trying to plot a tree from a tree-form list. The nodes should be connected from left to right (as usual). My range values are

m = {{5}, {4, 6}, {3, 5, 7}, {2, 4, 6, 8}}

The corresponding domain values are {0,1,2,3}

Naturally, this tree can grow larger.

Any constructive idea or guidance are greatly appreciated.

Here is a sample output plot (did it in Excel). enter image description here

$\endgroup$
3
  • 1
    $\begingroup$ Have you tried TreeForm[m]? $\endgroup$
    – m_goldberg
    Nov 14, 2015 at 1:59
  • 1
    $\begingroup$ I'm not sure what you want here. What is the output supposed to look like exactly? $\endgroup$
    – march
    Nov 14, 2015 at 2:53
  • $\begingroup$ Thanks for suggestions. @m_goldberg : just tried TreeForm[m], but it places all values at the final nodes. I need the progressing as I on the picture I posted. Just a regular tree plot. It's probably possible with TreeForm[m], but I'd need to transform my input m somehow. @march: thanks. posted a sample plot. $\endgroup$ Nov 14, 2015 at 4:49

2 Answers 2

2
$\begingroup$

I suspected LayeredGraphPlot may be helpful. I post this in case it assists in achieving goal.

m = {{5}, {4, 6}, {3, 5, 7}, {2, 4, 6, 8}};
r = Range[10];
rule = Thread[r -> Flatten[m]];
f[a_, b_] := MapThread[Function[{x, y}, {x, #} & /@ y]
   , {a, b}];
rag = Internal`PartitionRagged[r, {1, 2, 3, 4}];
u =Rule @@@Flatten[f[#1, Partition[#2, 2, 1]] & @@@Partition[rag, 2, 1], 2];
LayeredGraphPlot[u, Left, DirectedEdges -> False, 
 VertexRenderingFunction -> ({White, EdgeForm[Black], Disk[#, 0.3], 
     Black, Text[#2 /. rule, #1]} &)]

enter image description here

$\endgroup$
5
  • $\begingroup$ thank you. It should get me closer. I'll play with it now to try to work out the vertical positioning of nodes. $\endgroup$ Nov 15, 2015 at 5:45
  • $\begingroup$ Was sifting through script logic, but faced an error message: Flatten::normal: Nonatomic expression expected at position 1 in Flatten[part,2]. >> $\endgroup$ Nov 15, 2015 at 20:30
  • $\begingroup$ @EmilyHill could you clarify? Did the code not run or did you use a different case or are running components of code or something else? $\endgroup$
    – ubpdqn
    Nov 15, 2015 at 22:24
  • $\begingroup$ I tried to run the code, but faced the error posted earlier. Now, trying to figure out what might have caused this error :) Let me know, if this clarified it or if you need more info. Thanks @ubpdqn $\endgroup$ Nov 15, 2015 at 22:32
  • $\begingroup$ @EmilyHill it was my error part was referred to any was omitted in my cut and paste. I have posted corrected code. It runs now but check. Thank you for your patience. :-) $\endgroup$
    – ubpdqn
    Nov 16, 2015 at 0:11
0
$\begingroup$

Using the functions layersF and edgesF from this answer:

ClearAll[layersF, edgesF];
layersF = Module[{k = 1}, Table[k++, {i, #}, {j, i}]] &;
edgesF = Flatten[Thread /@ Thread[# -> Partition[#2, 2, 1]] & @@@ 
   Partition[layersF[#], 2, 1], 2]&;

m = {{5}, {4, 6}, {3, 5, 7}, {2, 4, 6, 8}};
el = edgesF @ Length[m];
vlabels = Thread[Flatten[layersF@Length[m]] -> (Placed[#, Center] & /@ Flatten[m])];
options = {VertexShapeFunction -> "Square", VertexSize -> {0.1, 0.1}, 
   ImagePadding -> 20, VertexStyle -> Hue[0.125`, 0.7`, 0.9`], 
   ImageSize -> 400, BaseStyle -> Arrowheads[Large]};

g = Graph[el, options, VertexLabels -> vlabels, 
  GraphLayout -> {"MultipartiteEmbedding", "VertexPartition" -> (Length /@ m)}]

enter image description here

Show[g, Frame -> True, 
 GridLines -> (gl = DeleteDuplicates /@ Transpose@GraphEmbedding[g]), 
 FrameTicks -> {{None, None}, {Transpose[{gl[[1]], Range[0, 3]}], None}}]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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