8

This is a problem from the recent 18th Kolmogorov competition on probability theory and statistics 2023. A random point P is chosen in an equilateral triangle. What is the probability that the distance from P to the center of the triangle is less than or equal to the distance between P and the boundary of the triangle? I am aware of

tr = Triangle[{{0, 0}, {1, 0}, {1/2, Sqrt[3]/2}}];
RandomPoint[tr]

I have got a problem to write down P as a random vector in WL. I'd like to see an answer in terms of Probability.

user64494
  • 26,149
  • 4
  • 27
  • 56

6 Answers6

15

As I noted in my comment, DirichletDistribution[] is the right distribution to use for uniformly sampling within a simplex. In particular, this generates barycentric coordinates for the triangle, so taking an appropriate linear combination of the vertices yields a point within the triangle.

The other answers have already shown where the parabolic arcs come from, so I'll skip ahead and present how to use Probability[]. (Note how I use a triangle centered at the origin to keep things simple):

tri = CirclePoints[{1, 0}, 3];
parabolas = Assuming[{x, y} ∈ Reals, 
    Simplify[RegionDistance[InfiniteLine[#], {x, y}]^2 - (x^2 + y^2) & /@ 
             Partition[tri, 2, 1, 1]]];

Probability[Block[{x, y}, {x, y} = {x1, x2, 1 - x1 - x2} . tri; And @@ Thread[parabolas >= 0]] // Evaluate, {x1, x2} [Distributed] DirichletDistribution[{1, 1, 1}]] 5/27

(N.B. to visualize the region of interest as in Syed's and cvgmt's answers, evaluate RegionPlot[And @@ Thread[parabolas > 0] // Evaluate, {x, -1, 1}, {y, -1, 1}].)

J. M.'s missing motivation
  • 124,525
  • 11
  • 401
  • 574
  • A good code is a commented code. However, I accept your answer. My trial was TransformedDistribution[ 1/Area[Triangle[{{0, 0}, {1, 0}, {1/2, Sqrt[3]/2}}]]* Boole[{x, y} \[Element] Triangle[{{0, 0}, {1, 0}, {1/2, Sqrt[3]/2}}]]*ud, ud \[Distributed] UniformDistribution[{{0, 1}, {0, 1}}]]. – user64494 Sep 19 '23 at 12:02
9
Clear["Global`*"];
r1 = Triangle[{{0, 0}, {1, 0}, {1/2, Sqrt[3]/2}}];
r2 = Circle[{x, y}, EuclideanDistance[{x, y}, RegionCentroid@r1]]
cond = RegionWithin[r1, r2];

RegionPlot[cond, {x, 0, 1}, {y, 0, 1}
 , Epilog -> {Red, Opacity[0.1], r1
   , Opacity[1], Point@RegionCentroid@r1}
 ]

enter image description here

r3 = ImplicitRegion[cond, {x, y}];
RegionMeasure[r3]/RegionMeasure[r1]

5/27

Syed
  • 52,495
  • 4
  • 30
  • 85
  • Thank you. This is done by hand with help of Mathematica. I'll be waiting for an answer which uses random variables and Probability. Of course, I think about it too. – user64494 Sep 19 '23 at 10:07
7

We directly translate the distance from P to the center of the triangle is less than or equal to the distance between P and the boundary of the triangle to Mathematica code.

triangle = RegularPolygon[3];
reg = ImplicitRegion[
  EuclideanDistance[{x, y}, RegionCentroid@triangle] <= 
   RegionDistance[RegionBoundary@triangle, {x, y}], {x, y}]
Area[reg]/Area[triangle]

5/27.

Graphics[{LightGreen, triangle, Magenta, reg // DiscretizeRegion}]

enter image description here

cvgmt
  • 72,231
  • 4
  • 75
  • 133
  • Thank you. This is done by hand with help of Mathematica. I'll be waiting for an answer which uses random variables and Probability. Of course, I think about it too. – user64494 Sep 19 '23 at 10:07
5

Maybe the following meets your request for the use of Probability. (This approach is essentially shamelessly stealing from @yarchik 's answer.)

Consider dividing the triangle into 3 equal parts and focus on the lower triangle:

triangle = ListPlot[{{-1/2, 0}, {1/2, 0}, {0, Tan[π/3]/2}, {-1/2, 0}}, 
  Joined -> True, PlotRangeClipping -> False, AspectRatio -> Tan[π/3]/2, 
  PlotRange -> {{-1/2, 1/2}, {0, Tan[π/3]/2}}];
lowersubTriangle = ListPlot[{{-1/2, 0}, {1/2, 0}, {0, Tan[π/6]/2}, {-1/2, 0}}, 
  PlotStyle -> Red, Joined -> True];
Show[triangle, lowersubTriangle]

Equilateral triangle and lower sub-triangle

Now calculate the squares of the distances of a random point to the center of mass (the peak of the lower triangle) and the floor of the lower triangle. We want to know the probability that d2com < d2floor.

(* Square of distance to center of mass*)
d2com = (x - 0)^2 + (y - Tan[π/6]/2)^2;

(* Square of distance to floor of triangle *) d2floor = y^2;

We sample uniformly in a rectangle that surrounds the lower triangle and account for the fact that we're only interested in half of the area of that rectangle by restricting the points to the lower triangle:

restrictions = y < (x + 1/2) Tan[π/6] && y < (1/2 - x) Tan[π/6];
probability = 2 Probability[d2com < d2floor && restrictions, 
  {x \[Distributed] UniformDistribution[{-1/2, 1/2}], 
   y \[Distributed] UniformDistribution[{0, Tan[π/6]/2}]}]
(* 5/27 *)
JimB
  • 41,653
  • 3
  • 48
  • 106
  • Something to adjust: what are d2com and d2floor? Your code (as presented in your answer) produces Boole[d2com < d2floor], not 5/27 to me. – user64494 Sep 19 '23 at 17:24
  • Sorry about that. I forgot to paste those in. I'll fix it. – JimB Sep 19 '23 at 17:26
  • +1. Now it works. However, d2com and d2floor are done by hand. Compare with parabolas = Assuming[{x, y} ∈ Reals, Simplify[RegionDistance[InfiniteLine[#], {x, y}]^2 - (x^2 + y^2) & /@ Partition[tri, 2, 1, 1]]]; in the J.M.'s answer. My trial was TransformedDistribution[ 1/Area[Triangle[{{0, 0}, {1, 0}, {1/2, Sqrt[3]/2}}]]* Boole[{x, y} \[Element] Triangle[{{0, 0}, {1, 0}, {1/2, Sqrt[3]/2}}]]*ud, ud \[Distributed] UniformDistribution[{{0, 1}, {0, 1}}]]. – user64494 Sep 19 '23 at 17:33
  • Equivalently: Probability[x^2 + (y - Tan[π/6]/2)^2 < y^2 /. Thread[{x, y} -> {x1, x2, 1 - x1 - x2} . {{-1/2, 0}, {1/2, 0}, {0, Tan[π/6]/2}}], {x1, x2} \[Distributed] DirichletDistribution[{1, 1, 1}]] – J. M.'s missing motivation Sep 19 '23 at 20:48
3

Here a geometric solution

ver = {{0, 0}, {1, 0}, {1/2, Sqrt[3]/2}};
tr = Triangle[ver];
rand = Line[{{0, 0}, {1, 0}, {1/2, Sqrt[3]/2}, {0, 0}}]
cent = RegionCentroid[tr];

reg = ImplicitRegion[Norm[cent - {x, y}] <= RegionDistance[rand, {x, y}] &&Element[{x, y}, tr], {x, y}] Show[{Graphics[rand], Region[reg]}]

enter image description here

Probability follows to

Area[reg]/Area[tr]
(*5/27*)
Ulrich Neumann
  • 53,729
  • 2
  • 23
  • 55
  • Thank you for your visualization. This is done by hand with help of Mathematica. I'll be waiting for an answer which uses random variables and Probability. – user64494 Sep 19 '23 at 10:05
2

Let us place the center at $(0,b)$ with

b = 1/2 Tan[Pi/6] 

The sub-triangle (by symmetry, it is indeed sufficient to consider a 1/6 of the original triangle) of interest is

Plot[{(x^2 + b^2)/(2 b), b (1 - 2 x)}, {x, 0, 1/2}]

enter image description here

The orange line is the line from the center to a triangle vertex. The blue line shows the curve of equal distances, solution of the equation $$ y^2=x^2+(b-y)^2. $$

The probability is the ratio of the two areas

s1 = Area[
  ImplicitRegion[0 <= y <= b (1 - 2 x) && 0 <= x <= 1/2, {x, y}]];
s2 = Area[
  ImplicitRegion[(x^2 + b^2)/(2 b) <= y <= b (1 - 2 x) && 0 <= x <= 1/2, {x, y}]]
s2/s1
(*5/27*)

Here, $s_1$ is the area of the triangle formed by the orange line and two axes. $s_2$ is the area of the part of the triangle above the blue parabola. If the distribution is uniform, the ratio of areas is equal to the probability of interest.

yarchik
  • 18,202
  • 2
  • 28
  • 66
  • Thank you. This is done by hand with help of Mathematica. I'll be waiting for an answer which uses random variables and Probability. Of course, I think about it too. – user64494 Sep 19 '23 at 10:09
  • @user64494 Yes, you are right, other solutions are also quite geometric and maybe even more straightforward in translating words into calculations. If a probabilistic solution is needed, you could perhaps ask a similar but more complicated question that does not have a geometric interpretation. But I do not have a concrete idea. – yarchik Sep 19 '23 at 10:23