# Draw a Probability Tree

I need to draw a probability tree to show the outcomes of three coin tosses. I see

as the beginning of what I need to create, but that tutorial doesn't cover things like labeling the legs with the probability of each direction, using custom labels, etc.

Essentially, I'd like to draw a diagram like the one in this answer:

Is this possible in Mathematica?

EDIT (by Vitaliy): I am adding diagram explicitly from the link given above, so it is easier to compare what I am trying to reproduce.

• Are you sure you read the tutorial you referenced? There is an example on how to label edges and one on how to customize vertex labels Aug 30, 2017 at 15:02
• @Mathe172 While there were hints about labeling and customizing, there wasn't a clear path to what I wanted to do, and definitely not a path to what Vitaliy Kaurov gave as an answer. I considered that this question might be broad enough, and of enough interest in general to rate a post on stackexchange. Aug 30, 2017 at 19:24

Just because it can get a bit more technical than simple labeling, I suggest one way of doing this. Perhaps you'll find some little details useful. First get the binary tree graph of a specific depth:

tree = KaryTree[2^4 - 1, DirectedEdges -> True]


Looks like you label levels with specific letters, not vertices per se. To automate this down to per-vertex label, start from a letter set labeling levels. Then process them according to binary tree structure:

levels={"A","F","S"};
labels={"ROOT"}~Join~
Flatten[Table[Table[{#,"NOT "<>#}&@
levels[[k]],2^(k-1)],{k,3}]];


Now you have to actually relabel vertices and edges from their default indices. Because your EdgeLabels are pretty manual I set random numbers for them, - you can use any manual list of names for that. (NOTE: probabilities are not balanced, you can take care of it yourself):

Vrelabel = Thread[Range[15] -> labels];
manualEDGE = Round[RandomReal[1, 14], .01];


Now you are ready to build your diagram (shown at the top):

SetProperty[tree,
{VertexLabels->Vrelabel,
EdgeLabels->Erelabel,
PlotTheme->"Marketing"}]

• I think a big component of this answer, though, is the terminal probability, the product of all the probabilities on edges from the root to each leaf. Did you have something in mind for that? Aug 30, 2017 at 21:51

This is probably not what is desired but exploits DiscreteMarkovProcess

mat = {{0, 0.5, 0.5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0,
0.5, 0.5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0.5,
0.5, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0.8, 0.2,
0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0.6, 0.4, 0, 0,
0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.6, 0.4, 0, 0}, {0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.2, 0.8}, {0, 0, 0, 0, 0, 0,
0, 1, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0,
0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0}, {0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 1, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0,
0}, {0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0}, {0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 1}};
labels = {1 -> "root", 2 -> "A", 3 -> "Not A", 4 -> "A-F",
5 -> "A-Not F", 6 -> "Not A-F", 7 -> "Not A-Not F", 8 -> "A-F-S",
9 -> "A-F-Not S", 10 -> "A-Not F-S", 11 -> "A-Not F-Not S",
12 -> "Not A-F-S", 13 -> "Not A-F-Not S", 14 -> "Not A-Not F-S",
15 -> "Not A-Not F-Not S"};
dm = DiscreteMarkovProcess[1, mat];
sd = StationaryDistribution[dm]
Graph[dm]
prob[j_] :=
Row[{"Probability(", j /. labels, "):",
Probability[x[Length[StringSplit[j /. labels, "-"]]] == j,
x \[Distributed] dm]}]
Column[prob /@ Range[2, 15]]


• +1 for using a Markov process. Aug 31, 2017 at 13:58

The question is only about drawing probability trees, but if we consider the tree drawing together with question's set-up of sequences of tosses, then we have a problem that is very well addressed with "Tries-with-frequencies".

Make sequences:

n = 12;
RandomChoice[{"F", "¬F"}, n], RandomChoice[{"S", "¬S"}, n]}]

(* {{"A", "F", "¬S"}, {"A", "F", "S"}, {"A", "F", "S"}, {"¬A",
"¬F", "¬S"}, {"A", "F", "S"}, {"A", "¬F", "S"}, {"A",
"¬F", "S"}, {"A", "F", "S"}, {"¬A", "¬F",
"¬S"}, {"¬A", "F", "S"}, {"¬A", "F", "¬S"}, {"A", "F",
"¬S"}} *)


Import the package TriesWithFrequencies.m:

Import["https://raw.githubusercontent.com/antononcube/MathematicaForPrediction/master/TriesWithFrequencies.m"]


Make the corresponding trie and convert the frequency nodes to probabilities:

tr = TrieNodeProbabilities[TrieCreate[seqs]]

(* {{{}, 1}, {{"¬A",
0.333333}, {{"F", 0.5}, {{"S", 0.5}}, {{"¬S", 0.5}}}, {{"¬F",
0.5}, {{"¬S", 1.}}}}, {{"A",
0.666667}, {{"¬F", 0.25}, {{"S", 1.}}}, {{"F",
0.75}, {{"¬S", 0.333333}}, {{"S", 0.666667}}}}} *)


Plot the trie:

TrieForm[tr]