# Expected area of random triangle

I want to check the following theorem by using Mathematica:

$\textbf{Theorem}$. If three point $P,Q,R$ are picked independently at random in the triangle $ABC$, than expected value of the area of triangle $PQR$ is

$S_{PQR}=\frac{1}{12}S_{ABC}$

I tried:

first I define triangle $ABC$ with area $S_{ABC}$

triangle = Triangle[{{0, 0}, {1, 1}, {2, 0}}];

area = Area[triangle]


but I don't know how to define new random triangle (random three point) inside the $ABC$ triangle.

I want to do something like this

t1=Graphics[{Red,triangle}]
t2=Graphics[{Black, rundomtriangle}]
Show[t1,t2]


than

S1=Area[triangle]
S2=Area[randomtriangle]


$\frac{S1}{S2}$ is a random number.

than plot this random numbers

ListPlot[S1/S2, S1/S2, S1/S2,...}]


but.. how to define randomtriangle ?

• (1) Pick random point in rectangle from 0 to 2 on x axis and 0 to 1 on y axis. (2) If it is inside ABC then keep it. (3) Else "fold" it along the appropriate upper edge to put it inside ABC. (4) Do this for three points and that gives your random triangle interior to ABC. Commented May 6, 2016 at 17:39
• maybe Triangle@RandomPoint[triangle,3]}?
– kglr
Commented May 6, 2016 at 17:42
• The analytical solution that the expected area is 1/12 is described here. Commented Jan 30, 2020 at 23:59

Edit I did not know about RandomPoint! New in v10.2 So just use

triangle = Triangle[{{0, 0}, {1, 1}, {2, 0}}];
randomtriangle = Triangle@RandomPoint[triangle, 3];


For the ListPlot:

areas = Area /@ Triangle /@ RandomPoint[triangle, {n, 3}];
ListPlot[Area[triangle]/area]


Unchanged:

For stuff like this (sampling from a region) the RegionDistribution function as defined in this post can be very useful. Copying the function unchanged:

RegionDistribution /:
RandomDistributionVector[RegionDistribution[reg_MeshRegion],
n_Integer, prec_?Positive] :=
Module[{d = RegionDimension@reg, cells, measures, s, m},
cells = DeveloperToPackedArray@MeshPrimitives[reg, d][[All, 1]];
s = RandomVariate[DirichletDistribution@ConstantArray[1, d + 1],
n];
measures = PropertyValue[{reg, d}, MeshCellMeasure];
m = RandomVariate[#, n] &@
EmpiricalDistribution[measures -> Range@Length@cells];
#[[All, 1]] (1 - Total[s, {2}]) + Total[#[[All, 2 ;;]] s, {2}] &@
cells[[m]]]


Then we can use it as follows:

triangle = Triangle[{{0, 0}, {1, 1}, {2, 0}}];

region = DiscretizeRegion@triangle;
pts = RandomVariate[RegionDistribution[region], 3];

randomtriangle = Triangle@pts;

t1 = Graphics[{
{Red, triangle},
{Black, randomtriangle}
}]


• Of course. Thanks! Commented May 6, 2016 at 17:52

The brute force approach:

        p0 = RandomReal[ {-1, 1}, {3, 2}]


{{-0.639468, -0.471533}, {-0.0621599, -0.952355}, {-0.253727, -0.133992}}

triangle = Triangle[p0];
a0 = Area[triangle];
p = Select[RandomReal[ {-1, 1}, {30000, 2}],
RegionMember[triangle, #] &];
Table[Area@Triangle[RandomSample[p, 3]]/a0, {1000}] // Mean


0.0826126 (* ~1/12 *)

I posted this mostly to point out a seemingly good approach that does not work:

p2 = {x, y} /.
FindInstance[ Element[ {x, y} , triangle], {x, y}, 1500];
Table[Check[Area@Triangle[RandomSample[p2, 3]]/a0, 0], {1000}] // Mean


0.151361

Why? Well the FindInstance distribution is not even close to uniform..

GraphicsRow[{Graphics[{Line[Append[p0, First@p0]], Point@p}],
Graphics[{Line[Append[p0, First@p0]], Point@p2}]}]


FindInstance give a lot of points exactly on the edges (So that many point triples are colinear, hence the need for Check )