14
$\begingroup$
TreePlot[{
    {0 -> "Mr 1", 1/10},
    {0 -> "Mr 2", 2/10},
    {0 -> "Mr 3", 3/10},
    {0 -> "Mr 4", 4/10},
    {"Mr 1" -> "A1",  2/10 },
    {"Mr 1" -> "B1",  1/10 },
    {"Mr 1" -> "C1",  7/10 },
    {"Mr 2" -> "A2",  3/10 },
    {"Mr 2" -> "B2",  2/10 },
    {"Mr 2" -> "C2",  5/10 },
    {"Mr 3" -> "A3",  4/10 },
    {"Mr 3" -> "B3",  3/10 },
    {"Mr 3" -> "C3",  3/10 },
    {"Mr 4" -> "A4",  5/10 },
    {"Mr 4" -> "B4",  4/10 },
    {"Mr 4" -> "C4",  1/10 }
}, 
VertexLabels ->
    {
        {0 -> None},
        { "A1" -> "A" },
        { "B1" -> "B" },
        { "C1" -> "C" },
        { "A2" -> "A" },
        { "B2" -> "B" },
        { "C2" -> "C" },
        { "A3" -> "A" },
        { "B3" -> "B" },
        { "C3" -> "C" },
        { "A4" -> "A" },
        { "B4" -> "B" },
        { "C4" -> "C" }
    },
    DirectedEdges -> True
]

Here is what I have. However, that's far from what I need.

enter image description here enter image description here

A few modifications are: 1 - to put it horizontally? 2 - Why aren't the labels showing? 3 - Could I increase the spaces between the edges so that the probabilities are displayed better?

Thanks.

$\endgroup$
  • 1
    $\begingroup$ Would be great if wolfram added a super function on top of Graph for decision trees of this sort since this is a common use case in business. $\endgroup$ – Mike Colacino Apr 5 at 17:41
16
$\begingroup$

We can use TreePlot (GraphComputation`TreePlotLegacy in versions 12.0+) with the hidden option "VertexNames" to label vertices with arbitrary labels.

We need a function to post-process TreePlot output to fix the default orientation of edge labels:

ClearAll[modifyArrowheads]
modifyArrowheads[dir_: Automatic] := ReplaceAll[Inset[a_, b__, None, c___] :> 
    Inset[Framed[a, Background -> White, FrameStyle -> None], b, dir,   c]];

Examples:

labelingrules = {0 -> None, "A1" -> "A", "B1" -> "B", "C1" -> "C", "A2" -> "A", 
  "B2" -> "B", "C2" -> "C", "A3" -> "A", "B3" -> "B", "C3" -> "C", 
  "A4" -> "A", "B4" -> "B", "C4" -> "C"};

vlabels = VertexList[edges[[All, 1]]] /. labelingrules /. None -> "    ";

tp = TreePlot[MapAt[InputForm, edges, {All, -1}], Left, 
  VertexLabeling -> True, "VertexNames" -> vlabels, 
  DirectedEdges -> True, BaseStyle -> "FontSize" -> 12, 
  AspectRatio -> 1, ImageSize -> Large];

modifyArrowheads[] @ tp 

enter image description here

To have the edge labels appear horizontal regardless of edge orientation use

modifyArrowheads[{None, None}] @ tp

enter image description here

We can use the (also hidden) options "VertexFrameStyle", "VertexFrameBackground" and "VertexTextStyle" to get a result similar to the hand-drawn picture in OP:

tp2 = TreePlot[MapAt[InputForm, edges, {All, -1}], Left, 
   VertexLabeling -> True, DirectedEdges -> True, 
   BaseStyle -> "FontSize" -> 12, AspectRatio -> 1, 
   ImageSize -> Large, "VertexNames" -> vlabels, 
   "VertexFrameStyle" -> None, "VertexFrameBackground" -> White, 
   "VertexTextStyle" -> {"Subsection", "FontColor" -> Blue}];

modifyArrowheads[] @ tp2

enter image description here

Aside: Re: "why are the ABC in decending order? Is there a way to work around for this minor anti-common practice?"

We can use an additional post-processing step to flip the graphics output vertically:

ClearAll[vFlipCoords]
vFlipCoords = ReplaceAll[GraphicsComplex[pts_, prims___] :> 
    GraphicsComplex[ReflectionTransform[{0, -1}]@pts, prims]];

vFlipCoords @ modifyArrowheads[] @ tp2

enter image description here

Full list of hidden options for TreePlot:

Network`GraphPlotDump`Private`hiddenOptions[TreePlot]
 {"VertexTooltips" -> Automatic, "EdgeTooltips" -> Automatic, 
 "EdgeLabels" -> Automatic, "VertexNames" -> Automatic, 
 "VertexSizes" -> Automatic, "VertexColor" -> Automatic, 
 "EdgeColor" -> Automatic, "VertexFrameBackground" -> Automatic, 
 "VertexFrameStyle" -> Automatic, "VertexFrameMargins" -> Automatic, 
 "VertexTextStyle" -> True, "Plot" -> True}

Note: We need the post-processing to 1/ add white background to edge labels and 2/ to ensure proper orientation of edge labels.

| improve this answer | |
$\endgroup$
  • $\begingroup$ Why are the ABC in decending order here, same as the other answer. Is there a way to work around for this minor anti common practice ? $\endgroup$ – CasperYC Apr 6 at 15:22
  • $\begingroup$ @CasperYC, please see the update. $\endgroup$ – kglr Apr 6 at 20:25
  • $\begingroup$ Sorry about the late response. SE is extremely difficult to acccess in China. Thanks again! $\endgroup$ – CasperYC Apr 14 at 13:45
19
$\begingroup$

It's a fussy solution, but it works.

edges = {{0 -> "Mr 1", 1/10}, {0 -> "Mr 2", 2/10}, {0 -> "Mr 3", 
    3/10}, {0 -> "Mr 4", 4/10}, {"Mr 1" -> "A1", 
    2/10}, {"Mr 1" -> "B1", 1/10}, {"Mr 1" -> "C1", 
    7/10}, {"Mr 2" -> "A2", 3/10}, {"Mr 2" -> "B2", 
    2/10}, {"Mr 2" -> "C2", 5/10}, {"Mr 3" -> "A3", 
    4/10}, {"Mr 3" -> "B3", 3/10}, {"Mr 3" -> "C3", 
    3/10}, {"Mr 4" -> "A4", 5/10}, {"Mr 4" -> "B4", 
    4/10}, {"Mr 4" -> "C4", 1/10}};

labels = {"A1" -> "A", "B1" -> "B", "C1" -> "C", "A2" -> "A", 
   "B2" -> "B", "C2" -> "C", "A3" -> "A", "B3" -> "B", "C3" -> "C", 
   "A4" -> "A", "B4" -> "B", "C4" -> "C"};
g = Graph[
 edges[[All, 1]],
 EdgeLabels -> Map[First[#] -> Placed[Framed[InputForm@Last[#], FrameStyle -> None, FrameMargins -> 1], {.7 (* position along edge *), {.5, 0.6} (* relative position within label *) }] &, edges],
 EdgeLabelStyle -> Directive[10 (* font size *), Background -> White],
 VertexLabels -> Flatten[{Placed["Name", Center] (* default label *), 0 -> None, MapAt[Placed[#, Center] &, labels, {All, 2}]}],
 VertexSize -> 0.7,
 GraphStyle -> "DiagramGold",
 GraphLayout -> {"LayeredEmbedding", "Orientation" -> Left, LayerSizeFunction -> (5 &)}
]

enter image description here


From the comments:

A minor question, why are the ABC in decending order?

You can extract the vertex coordinates, flip them vertically, and set them on the graph again.

Graph[g, VertexCoordinates -> 
  Thread[VertexList[g] -> (# {1, -1} &) /@ GraphEmbedding[g]]]

With IGraph/M, doing this is much simpler:

IGVertexMap[{1, -1} # &, VertexCoordinates, g]

Personally, I do not do anything with graphs without IGraph/M ;-) IGraph/M also has a tree-drawing function, which happens to rotate the layout into a horizontal orientation differently.

IGLayoutReingoldTilford[g, "Rotation" -> Pi/2, "LayerHeight" -> 5]
| improve this answer | |
$\endgroup$
  • 2
    $\begingroup$ Your EdgeLabels are all the same. Should be Map[First@# -> Placed[InputForm[ Last@#], {.7 , {.5, 0.75} }] &, edges] instead. $\endgroup$ – Edmund Apr 5 at 23:53
  • $\begingroup$ @Edmund Thank you! I don't know how I could have not noticed that ... $\endgroup$ – Szabolcs Apr 6 at 7:58
  • $\begingroup$ seemed like a lot more work was needed to make the adjustments. A minor question, why are the ABC in decending order? I thought it was my machine, but it's all the same for any version of MMA.... $\endgroup$ – CasperYC Apr 6 at 15:19
  • $\begingroup$ I tried using right but it's like a mirror. I guess that's just the way it is then.... $\endgroup$ – CasperYC Apr 6 at 15:21
  • $\begingroup$ @CasperYC See update. $\endgroup$ – Szabolcs Apr 6 at 15:39

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.