SHARE
TWEET

Finding right triangles in random points

a guest Apr 5th, 2017 129 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. n = 12; (* How many points *)
  2. pts = Table[RandomReal[], {n}, {2}];
  3. Show[
  4.  Graphics[{Red, PointSize[0.01], Point[pts]}],
  5.  ImageSize -> 8*72, PlotRange -> {{0, 1}, {0, 1}}, Frame -> True,
  6.  FrameTicks -> False
  7.  ]
  8.  
  9. \[Theta]min = 89.0; (* Range of angles to be considered "right" (in \
  10. degrees) *)
  11. \[Theta]max = 91.0;
  12. RightAngles = {};
  13. Do[(
  14.   ptA = pts[[i]];
  15.   ptB = pts[[j]];
  16.   ptC = pts[[k]];
  17.  
  18.   a = Norm[ptB - ptC];
  19.   b = Norm[ptA - ptC];
  20.   c = Norm[ptA - ptB];
  21.  
  22.   AngleA = 180/\[Pi] ArcCos[(b^2 + c^2 - a^2)/(2 b c)];
  23.   If[\[Theta]min <=
  24.     AngleA <= \[Theta]max, (AppendTo[RightAngles, {ptA, ptB, ptC}];
  25.     Continue[];)];
  26.   AngleB = 180/\[Pi] ArcCos[(a^2 + c^2 - b^2)/(2 a c)];
  27.   If[\[Theta]min <=
  28.     AngleB <= \[Theta]max, (AppendTo[RightAngles, {ptA, ptB, ptC}];
  29.     Continue[];)];
  30.   AngleC = 180/\[Pi] ArcCos[(a^2 + b^2 - c^2)/(2 a b)];
  31.   If[\[Theta]min <= AngleC <= \[Theta]max,
  32.    AppendTo[RightAngles, {ptA, ptB, ptC}]];
  33.   ), {i, 1, n - 2}, {j, i + 1, n - 1}, {k, j + 1, n}]
  34.  
  35. RightAngles (* Print the list of triples of vertices that form \
  36. "right-ish" triangles *)
  37. RightAngles // Length (* And how many there are *)
  38.  
  39. (* Show the "right" triangles overlaid over the random points *)
  40. Show[
  41.  Graphics[{Red, PointSize[0.02], Point[pts]}],
  42.  Table[Graphics[{Thick, Hue[i/Length[RightAngles]],
  43.     Line[{RightAngles[[i, 1]], RightAngles[[i, 2]],
  44.       RightAngles[[i, 3]], RightAngles[[i, 1]]}]}], {i, 1,
  45.    Length[RightAngles]}],
  46.  ImageSize -> 8*72, Frame -> True, FrameTicks -> False,
  47.  PlotRange -> {{0, 1}, {0, 1}}
  48.  ]
  49.  
  50. (* Create the list of unique side lengths in this set of triangles *)
  51.  
  52.  
  53. lengths = {};
  54. Do[(
  55.    AppendTo[lengths, Norm[RightAngles[[i, 1]] - RightAngles[[i, 2]]]];
  56.    AppendTo[lengths, Norm[RightAngles[[i, 1]] - RightAngles[[i, 3]]]];
  57.    AppendTo[lengths, Norm[RightAngles[[i, 2]] - RightAngles[[i, 3]]]];
  58.    ), {i, 1, Length[RightAngles]}];
  59. lengths = Union[lengths, lengths];
  60.  
  61. (* Here is a set of "special" numbers to search for in ratios of \
  62. these lengths, along with their reciprocals *)
  63. nums = {\[Pi], E, EulerGamma, GoldenRatio, Sqrt[2], Sqrt[3], Sqrt[5],
  64.    Sqrt[6], Sqrt[7], Sqrt[8], Sqrt[10]};
  65.  
  66. (* Make a list of of side length ratios that "match" the above set of \
  67. special numbers *)
  68. f = 0.01; (* What fractional deviation from the "special" numbers is \
  69. acceptable *)
  70. Specials = {};
  71. Do[(
  72.    r = lengths[[i]]/lengths[[j]];
  73.    Do[(
  74.      x = nums[[k]];
  75.      If[Abs[(r - x)/x] <= f,
  76.       AppendTo[
  77.        Specials, {lengths[[i]], lengths[[j]], r, x, Abs[(r - x)/x]}]];
  78.      If[Abs[(r - (1/x))/(1/x)] <= f,
  79.       AppendTo[
  80.        Specials, {lengths[[i]], lengths[[j]], r, 1/x,
  81.         Abs[(r - (1/x))/(1/x)]}]];
  82.      ), {k, 1, Length[nums]}]
  83.    ), {i, 1, Length[lengths]}, {j, 1, Length[lengths]}];
  84.  
  85. Specials (* Print the list of "special" side length relationships and \
  86. how accurate they are *)
  87. Specials // Length
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top