3
$\begingroup$

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 ?

$\endgroup$
3
  • 1
    $\begingroup$ (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. $\endgroup$ May 6 '16 at 17:39
  • 1
    $\begingroup$ maybe Triangle@RandomPoint[triangle,3]}? $\endgroup$
    – kglr
    May 6 '16 at 17:42
  • 1
    $\begingroup$ The analytical solution that the expected area is 1/12 is described here. $\endgroup$ Jan 30 '20 at 23:59
4
$\begingroup$

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 /: 
 Random`DistributionVector[RegionDistribution[reg_MeshRegion], 
  n_Integer, prec_?Positive] := 
 Module[{d = RegionDimension@reg, cells, measures, s, m}, 
  cells = Developer`ToPackedArray@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}
 }]

enter image description here

$\endgroup$
1
  • $\begingroup$ Of course. Thanks! $\endgroup$ May 6 '16 at 17:52
1
$\begingroup$

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

enter image description here

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

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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