12
$\begingroup$

Consider a stick of length 1. Pick two points uniformly at random on the stick, and break the stick at those points. What is the probability that the three segments obtained in this way form a triangle?

I have implemented two versions. Version 1 works correctly, but version 2 doesn't. How can I fix the second version?

Version 1

Module[{min,  max},
  {min, max} = {Min@#, Max@#} & /@ RandomReal[1, {10^5, 2}] // Transpose;
  Mean@MapThread[
    Function[{x, y, z}, N@Boole[x + y > z && x + z > y && y + z > x]],
    {min, max - min, 1 - max}]]

Version 2

Block[{t1, t2, t3},
  t1 = {x > 0, y > 0, x + y < 1};
  t2 = {x + y > z, x + z > y, y + z > x} /. z -> 1 - x - y;
  Print[t3 = And @@ t1 ~ Join ~ t2 // FullSimplify];
  Probability[t3,
    Distributed[x,  UniformDistribution[{0, 1}]] &&
    Distributed[y,  UniformDistribution[{0, 1}]]]]
$\endgroup$
1
  • $\begingroup$ I think you are mixing up the "coordinate" of the breaking point with the length of the resulting stick segment. The length of the resulting stick segment is y-x, not y. See also math.stackexchange.com/questions/676/… by the way. $\endgroup$ Mar 19 '13 at 10:42
17
$\begingroup$

I think you are mixing up the "coordinate" of the breaking point with the length of the resulting stick segment. The length of the resulting stick segment is y-x, (if y>x) not y. If we want x and y to be uniformly distributed, it is is useful to think in terms of the length of the leftmost stick segment l1=Min[x,y] and the length of the center stick segment which is l2=Max[x,y]-Min[x,y] (=Abs[x-y])

This seems to be what you want

Block[{t1, t2, t3},
 t1 = {1 > x > 0, 1 > y > 0};
 t2 = {Min[x, y] + (Max[x, y] - Min[x, y]) > z, 
    Min[x, y] + z > (Max[x, y] - Min[x, y]), (Max[x, y] - Min[x, y]) +
       z > Min[x, y]} /. z -> 1 - Max[x, y];
 Print[t2];
 Print[t3 = And @@ t1~Join~t2 // FullSimplify];
 Probability[t3, 
  Distributed[x, UniformDistribution[{0, 1}]] && 
   Distributed[y, UniformDistribution[{0, 1}]]]]

-> 1/4

Possibly the following is nicer

Block[
 {t1, t2, t3, x, y, l1, l2, l3},
 t1 = {1 > x > 0, 1 > y > 0};
 t2 = {l1 + l2 > l3, l1 + l3 > l2, l2 + l3 > l1} /. {l1 -> Min[x, y], 
    l2 -> Abs[x - y], l3 -> 1 - Max[x, y]};
 Print[t3 = And @@ t1~Join~t2 // FullSimplify];
 Probability[t3, 
  Distributed[x, UniformDistribution[{0, 1}]] && 
   Distributed[y, UniformDistribution[{0, 1}]]]]

-> 1/4

$\endgroup$
3
  • $\begingroup$ Yep - you're right (and beat me to it:) ). Can also be simplified to one condition t = {0 < x < 1/2, 1/2 < y < 1, 1 - x - y < 1/2}; $\endgroup$
    – gpap
    Mar 19 '13 at 10:56
  • $\begingroup$ Probability[t3, Distributed[{x, y}, UniformDistribution[{{0, 1}, {0, 1}}]]] is it right? $\endgroup$
    – chyanog
    Mar 19 '13 at 11:00
  • $\begingroup$ @chyanog yeah I think so. It only puts emphasis on the independence of x and y I think, they are independently generated anyway so it does not matter. gpap I like your observation :). Next time u beat me :) $\endgroup$ Mar 19 '13 at 11:04
15
$\begingroup$

Amazingly, the most direct and mindless possible approach works instantaneously.

Start by characterizing the valid side lengths: each side is the shortest distance between its endpoints; the path made by the other two sides cannot be any shorter.

triangleQ[x_, y_, z_] := x <= y + z && y <= z + x && z <= x + y;

Break the stick uniformly and independently at locations $u_1$ and $u_2$:

f = UniformDistribution[{{0, 1}, {0, 1}}];

Unit line

Noting that the breaks (from left to right) create pieces of length $\min(u_1,u_2)$, $|u_2-u_1|$, and $1 - \max(u_1, u_2)$, request the probability that the pieces form a triangle:

Probability[triangleQ[Min[u1, u2], Abs[u2 - u1], 1 - Max[u1, u2]], {u1, u2} \[Distributed] f ]

$\frac{1}{4}$

$\endgroup$
4
  • $\begingroup$ +1, I like mindless solutions. That's why we have MMA right? I'd name triangleQ differently, the Q makes me think it can only return True or False $\endgroup$
    – Rojo
    Mar 19 '13 at 18:27
  • $\begingroup$ @Rojo (Apart from True or False, what else could triangleQ return (assuming it is passed three nonnegative real numbers)?) Your comment about mindless solutions is a penetrating one: "mindless" translates to "easily seen to be a correct implementation of the question," which satisfies the Prime Directive of getting the right answer above all else. $\endgroup$
    – whuber
    Mar 19 '13 at 19:13
  • $\begingroup$ Nothing else, but predicates seem to not be symbolic functions. Compare Equal to SameQ. And here triangleQ is being used as symbolic. I'm not sure what "penetrating" means in this context. It's a disturbing word $\endgroup$
    – Rojo
    Mar 19 '13 at 22:38
  • $\begingroup$ @Rojo "Penetrating," in its metaphorical use here, means "going into the substance of the matter." $\endgroup$
    – whuber
    Mar 19 '13 at 22:40
13
$\begingroup$

Each uniform divides the stick into a smaller and a longer side. If the smaller side of both uniforms coincide (left-left, or right-right) then you won't have a triangle because the rightmost/leftmost division will be longer than 0.5. The odds of this happening is 1/2. If they don't coincide, then you will have a triangle only when the sum of the smallest sides is higher than 0.5. So,

1/2 Probability[
  x + y < 1/2, {x, y} \[Distributed] 
    TransformedDistribution[Min[z, 1 - z], 
     z \[Distributed] UniformDistribution[]] // Thread]

(* 1/4 *)

By the way

With[{min := Min[x, y], max := Max[x, y]}, 
 RegionPlot[
  And @@ Thread[0 < {x, y} < 1] && 
   Max[min, max - min, 1 - max ] < 1/2, {x, 0, 1}, {y, 0, 1}]]

Mathematica graphics

$\endgroup$
11
$\begingroup$

You can also use OrderDistribution (to get the joint distribution of Min and Max in a sample of size 2 from a standard Uniform distribution) combined with a simpler condition:

dist = OrderDistribution[{UniformDistribution[], 2}, {1,2}]; 
Probability[y > 1/2 && 1/2 > y - x && 1/2 > x, Distributed[{x, y}, dist]]
(* 1/4 *)
Probability[Max[x, y - x, 1 - y] < 1/2, Distributed[{x, y}, dist]] (* thanks: Rojo *)
(* 1/4 *)
$\endgroup$
3
  • $\begingroup$ @Rojo, thank you. $\endgroup$
    – kglr
    Mar 19 '13 at 12:04
  • $\begingroup$ This has my symbolic accept $\endgroup$
    – Rojo
    Mar 19 '13 at 12:31
  • 1
    $\begingroup$ Max[x, y - x, 1 - y] < 1/2 is a nice alternative notation for the condition $\endgroup$
    – Rojo
    Mar 19 '13 at 12:40
1
$\begingroup$

This is just a variant of Rojo's argument.

If one considers the lengths of the segments rather than the points then:

Probability[
 x + y > 1/2 && x < 1/2 && y < 1/2 \[Conditioned] 
  x + y < 1, {x, y} \[Distributed] UniformDistribution[2]] 

yielding 1/4

You can see this as follows:

FullSimplify@
 Reduce[x + y + z == 1 && x + y > z && x + z > y && y + z > x && 
   x > 0 && y > 0 && z > 0, {x, y, z}, Reals]

gives:

2 x < 1 && x + y > 1/2 && 2 y < 1 && x + y + z == 1

A little fun:

c = x + y > 1/2 && x < 1/2 && y < 1/2;
rp = RegionPlot[{x + y < 1, c}, {x, 0, 1}, {y, 0, 1}, 
   PlotStyle -> {LightRed, LightBlue}, BoundaryStyle -> None, 
   ImageSize -> 300];
tf[p_] := Module[{u, v, tg},
  {u, v} = p;
  tg = Quiet[SSSTriangle[u, v, 1 - u - v]] /. 
    SSSTriangle[__] :> Text["Does not form a triangle", {0.5, 0.5}];
  Graphics[tg, PlotRange -> Table[{0, 1}, 2], Frame -> True, 
   ImageSize -> 300]]
Manipulate[
 Row[{Show[rp, Graphics[Point[pt]]], tf@pt}],
 {{pt, {0.4, 0.4}}, Locator}]

enter image description here

$\endgroup$
2
  • $\begingroup$ Very nice! This is what interactive displays are all about. $\endgroup$
    – JimB
    Nov 16 '16 at 4:09
  • $\begingroup$ @JimBaldwin thanks. Hope you got a good nights sleep. :) $\endgroup$
    – ubpdqn
    Nov 16 '16 at 4:11

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.