Draw a Probability Tree

Question

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

https://reference.wolfram.com/language/tutorial/TreeDrawing.html

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:

https://stats.stackexchange.com/a/59460/89799

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.

Answer 1

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];
Erelabel = Thread[EdgeList[tree] -> manualEDGE];

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

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

Answer 2

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]]

Answer 3

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;
seqs = Thread[{RandomChoice[{"A", "¬A"}, n], 
   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]