17
$\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
  • 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$ Apr 5, 2020 at 17:41

2 Answers 2

20
$\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.

$\endgroup$
3
  • $\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, 2020 at 15:22
  • $\begingroup$ @CasperYC, please see the update. $\endgroup$
    – kglr
    Apr 6, 2020 at 20:25
  • $\begingroup$ Sorry about the late response. SE is extremely difficult to acccess in China. Thanks again! $\endgroup$
    – CasperYC
    Apr 14, 2020 at 13:45
21
$\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]
$\endgroup$
5
  • 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, 2020 at 23:53
  • $\begingroup$ @Edmund Thank you! I don't know how I could have not noticed that ... $\endgroup$
    – Szabolcs
    Apr 6, 2020 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, 2020 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, 2020 at 15:21
  • $\begingroup$ @CasperYC See update. $\endgroup$
    – Szabolcs
    Apr 6, 2020 at 15:39

Your Answer

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

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