# Visualizing a Probability Space in Wolfram w/Two Events?

For two events say $$A$$ and $$B$$, and supposing we have the data: $$P(A)$$, $$P(B)$$, $$P(A|B)$$ and $$P(B|A)$$, is there a way to generate something like a "probability venn diagram" from this information? The following information online is kind of what I mean: If there are other ways of visualizing this in Wolfram then I would be interested in those approaches as well.

Usually, this works:

Generating random probabilities:

SeedRandom;
(
Label["Beginning"];
PA = RandomReal[{0, 1}];
PB = RandomReal[{0, 1}];
PAcondB = RandomReal[{0, 1}];
PAandB = PAcondB PB;
PBcondA = PAandB/PA;
If[PB + PA - PAandB > 1. || PBcondA > 1., Goto["Beginning"];];
)


Determining disks for the events A and B and a region of area 1 that contains both:

rA = Sqrt[PA/Pi];
rB = Sqrt[PB/Pi];
ΩA[x_] := Disk[{-x/2, 0}, rA];
ΩB[x_] := Disk[{x/2, 0}, rB];
F[x_] := Area[RegionIntersection[ΩA[x], ΩB[x]]];
d = x /. FindRoot[F[x] == PAandB, {x, Max[rA, rB] - Min[rA, rB], 0.999999 (rA + rB)}];

union = BoundaryDiscretizeRegion[
RegionUnion[ΩA[d], ΩB[d]],
MaxCellMeasure -> {1 -> 0.01}
];
Ω = TransformedRegion[union, {x, y} \[Function] 1/Sqrt[Area[union]] {x, y}];
Graphics[{
White, EdgeForm[Black], Ω,
Opacity[0.5],
Blue, ΩA[d],
Red, ΩB[d]
}] The shape for the overall probability space is not overly beautiful. Maybe anybody else finds a way to round it off nicely.

• For the shape for the overall probability space you can use BoundingRegion[\[CapitalOmega], "FastEllipse"] (+1 of course) – kglr Aug 26 '19 at 5:40

Given any three of the five magnitudes $$P(A), P(B), P(A\cap B), P(A|B), P(B|A)$$, the remaining two are determined thru well known relations. We generate the first three randomly.

SeedRandom
{pa, pb} = RandomReal[{0, 1}, 2]


{0.183545, 0.903397}

pab = RandomReal[{0, Min[pa, pb]}]


0.138116

{pbconda, pacondb} = pab/{pa, pb}


{0.752495, 0.152886}

The radii of the two circles that represent the events $$A$$ and $$B$$:

{ra, rb} = Sqrt[{pa, pb} / Pi]


{0.241711, 0.536246}

To find how far apart the two circles should be, we can use the function A[R, r, d] from Eric Weisstein - "Circle-Circle Intersection" from MathWorld for the area of the asymmetric lens in the intersection of two circles with radii R and r and centered at {0, 0} and {d, 0}, respectively.

ClearAll[A]
A[R_, r_, d_] :=  r^2 ArcCos[(d^2 + r^2 - R^2)/(2 d r)] +
R^2 ArcCos[(d^2 + R^2 - r^2)/(2 d R)] -
Sqrt[(-d + r + R) (d + r - R) (d - r + R) (d + r + R)]/2

xd = x /. FindRoot[A[ra, rb, x] - pab, {x, (ra + rb)/2}]


0.421014

Graphics[{EdgeForm[Thick], FaceForm[Opacity[.5]], Red,
Disk[{0, 0}, ra], Blue,  Disk[{xd, 0}, rb], FaceForm[Opacity],
Disk[{xd/2, 0}, 1/(pa + pb - pab)],
Text[Style["A", 16, Black], Offset[{-5, 0}, {-ra, 0}], Right],
Text[Style["B", 16, Black], Offset[{5, 0}, {xd + rb, 0}], Left],
Text[Style["A⋂B", 16, Black],
Offset[{-20, 0}, {xd/2, 0}], Center]}] Verify that the ratios of the intersection to the two disk areas match the given conditional probabilities:

Chop[Norm[
Area[RegionIntersection[Disk[{0, 0}, ra],  Disk[{xd, 0}, rb]]] /
{Area[Disk[{0, 0}, ra]], Area[  Disk[{xd, 0}, rb]]} -
{pbconda, pacondb}], 10^-9]


0