5
$\begingroup$

If I am given 10 points in the coordinate system in the for (x,y); where x is the x-coordinate and y is the y-coordinate.

Is there a way that I can predict if there is a right angled triangle possible with these vertices? (Not by taking 3 vertices at a time and applying Pythagoras and checking? Is there a way?)

Thanks for any help in advance.. :)

$\endgroup$
  • $\begingroup$ Why would anybody vote to close this interesting question? $\endgroup$ – eldo Oct 5 '14 at 23:51
  • 3
    $\begingroup$ I am confused - are you searching for a mathematical theorem to determine the presence of right triangles or are you wondering if Mathematica can identify right triangles in a set of points? If the former, this is not the right forum; if the latter, then why must the answer not involve the Pythagorean theorem? $\endgroup$ – bobthechemist Oct 5 '14 at 23:51
  • $\begingroup$ @bobthechemist And ... you can't do it without "taking three points at a time" b/c you need to consider all segments ... $\endgroup$ – Dr. belisarius Oct 6 '14 at 7:38
  • 1
    $\begingroup$ @eldo Utter absence of an example? That would be my guess (for votes to close, that is). $\endgroup$ – Daniel Lichtblau Oct 6 '14 at 15:02
  • $\begingroup$ working on this? codechef.com/OCT14/problems/CHEFSQUA $\endgroup$ – george2079 Oct 6 '14 at 19:13
9
$\begingroup$

I made 10 points randomly and selected points as vertex of right-angled triangle using VectorAngle.

pts = RandomInteger[{0, 9}, {10, 2}]

{{2, 6}, {7, 9}, {8, 7}, {4, 8}, {1, 1}, {7, 3}, {9, 1}, {3, 1}, {4, 4}, {7, 3}}

vts = Permutations[pts, {3}];
rst = Select[vts, VectorAngle @@ Differences[#1] == \[Pi]/2 &];
trig = Union[rst, SameTest -> (Sort[#1] == Sort[#2] &)]

{{{1, 1}, {4, 4}, {2, 6}}, {{2, 6}, {8, 7}, {9, 1}}, {{3, 1}, {4, 4}, {7, 3}}, {{4, 4}, {2, 6}, {4, 8}}, {{4, 8}, {8, 7}, {7, 3}}, {{7, 9}, {4, 4}, {9, 1}}}

I verified with drawing the triangles like this.

Graphics[{EdgeForm[Darker@Orange], 
  Opacity[.5], {ColorData["Atoms", "ColorList"][[1 ;; Length[trig]]], 
    Polygon[Append[#, First[#]]] & /@ trig} // Transpose, Opacity[1], 
  PointSize[Medium], Red, Point@pts}, Axes -> True]

Blockquote

$\endgroup$
  • $\begingroup$ +1 IMO you could even improve your nice answer by just telling us True (at least one right-angled) or False :) $\endgroup$ – eldo Oct 5 '14 at 23:56
  • 1
    $\begingroup$ I just wondered how can there be so many right angled triangles if you only "made 10 points randomly", then I realized that your points are all on the Interger lattices. $\endgroup$ – Harry Oct 6 '14 at 1:35
  • $\begingroup$ Maybe rst = Select[vts, Dot @@ Differences[#] == 0 &]; is a cheaper approach than VectorAngle ? $\endgroup$ – Harry Oct 6 '14 at 1:56
  • $\begingroup$ @Harry You right thanks. $\endgroup$ – Junho Lee Oct 6 '14 at 2:36
3
$\begingroup$

Using test case of Juhno Lee (noting repeated point {7,3}):

test = {{2, 6}, {7, 9}, {8, 7}, {4, 8}, {1, 1}, {7, 3}, {9, 1}, {3, 
   1}, {4, 4}, {7, 3}}

Function to select points:

fun[tp_] := Module[{sb},
  If[Length[Union@tp] < 3, 1,
   sb = Partition[tp,2,1,1];
   #1.#2 & @@Flatten[Differences /@Most@SortBy[sb, N[EuclideanDistance @@ #] &], 1]]]

Applying:

sub = Subsets[test, {3}];
trn = Union[Sort /@ Pick[sub, fun /@ sub, 0]]

Visualizing:

anim = Show[
     ListPlot[test, PlotMarkers -> {Automatic, 10}, PlotStyle -> Red],
      Graphics[{EdgeForm[Thick], Blue, Opacity[0.5], Polygon[#]}], 
     PlotRange -> All, AspectRatio -> 1, Frame -> True, 
     PlotRange -> Table[{0, 9}, {2}]] & /@ trn;

Animated gif for frames:

enter image description here

UPDATE In response to eldo's comment:

g[pts_] := 
 With[{s = Subsets[pts, {3}]}, Union[Sort /@ Pick[s, fun /@ s, 0]]]

For sample of 100 random integer point sets of size 10:

cnt = RandomInteger[9, {100, 10, 2}];
anim2 = MapThread[
  Column[{Show[
      ListPlot[#1, PlotMarkers -> {Automatic, 10}, PlotStyle -> Red], 
      Graphics[{EdgeForm[Thick], Blue, Opacity[0.5], Polygon[##2]}], 
      PlotRange -> All, AspectRatio -> 1, Frame -> True, 
      PlotRange -> Table[{0, 9}, {2}]], Length@#2}, 
    Alignment -> Center] &, {cnt, (g /@ cnt)}];

The number of right triangle is displayed below graphic:

enter image description here

The mean number of right triangles found was 10.39 median 10, range: 1 to 21. This histogram is shown below:

enter image description here

In three simulations of sample size 10000, no right triangles occurred 12,10 and 11->Probability at least 1 right triangle from 10 points with integer valued points:$\approx 0.9990$.

Here are 11 configurations without right triangle from one 10000 simulation:

enter image description here

$\endgroup$
  • $\begingroup$ Rephrasing my comment to Junho Lee's answer: How many right-angled triangles are there? Could you provide an Integer between 0 and 1000 ? +1 anyway :) $\endgroup$ – eldo Oct 6 '14 at 4:37
  • $\begingroup$ @eldo 6 for original test case, see update $\endgroup$ – ubpdqn Oct 6 '14 at 5:19

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.