3

There are at least a few non-overlapping triangles made by the lines in the following graphic, how would I isolate them?

pts = RandomReal[1, {7, 2, 2}];
g = Graphics[{InfiniteLine @@@ pts}, Frame -> True, 
  PlotRange -> {{-1, 2}, {-1, 3}}]

enter image description here

Update:

Jason B gave a nice answer, but it needs it to work with both Line[] and InfiniteLine[], for which the triangles[] function below doesn't work:

SeedRandom[4430];
pts = RandomReal[1, {3, 2, 2}];
l = InfiniteLine @@@ pts; h = 
 Line@{{{0, 0}, {0, 2}}, {{0, 1}, {1, 1}}, {{1, 0}, {1, 2}}};
lines = Join[l, {h}];
g = Graphics[{lines, LightBlue, Triangle /@ triangles[lines]}, 
  Frame -> True, PlotRange -> All, AspectRatio -> 1]

enter image description here

user5601
  • 3,573
  • 2
  • 24
  • 56
  • 1
    Suggestion: 1) Find the set ${\cal P}$ of all intersection points by finding intersections of all pairs of lines, 2) find the set ${\cal S}$ of all potential triangles by taking all triplets of such points in ${\cal P}$ where each pair lie on the same line, 3) delete from ${\cal S}$ all triangles that contain another point from ${\cal P}$. – David G. Stork Mar 06 '18 at 17:06
  • Possible duplicate of https://mathematica.stackexchange.com/q/97732/9490 – Jason B. Mar 06 '18 at 17:26

1 Answers1

3

Borrowing from this answer,

triangles[lines:{__InfiniteLine}]:= Module[
    {lineSegments,vertices,edges,triangles},
    lineSegments = Flatten[
        Map[Function @ Partition[Sort @ #, 2, 1],
            Table[
                Flatten[
                    List@@@Map[RegionIntersection[Part[lines, n], #]&, Delete[lines, n]],
                    1
                ],
                {n, Length @ lines}
            ]
        ],
        1
    ]; 

   vertices = Flatten[lineSegments, 1] // DeleteDuplicates;
   edges = lineSegments /. MapIndexed[#1 -> First@#2 &, vertices];
   triangles = FindCycle[Graph[#1 \[UndirectedEdge] #2 & @@@ edges], {3}, All];
   triangles = triangles[[All,All,1]];
   vertices[[#]]&/@triangles
]

Plotting directly as

SeedRandom[4430];
pts = RandomReal[1, {7, 2, 2}];
lines = InfiniteLine @@@ pts;
g = Graphics[{lines, LightBlue, Triangle /@ triangles[lines]}, 
  Frame -> True, PlotRange -> All]

enter image description here

Jason B.
  • 68,381
  • 3
  • 139
  • 286
  • Ah, nice answer. But what if I had lines as well? like this l = InfiniteLine @@@ pts; h = Line @ {{{0, 0}, {0, 2}}, {{0, 1}, {1, 1}}, {{1, 0}, {1, 2}}}; lines = Join[l, {h}] – user5601 Mar 06 '18 at 18:19
  • 1
    It should be fairly straightforward to modify this to account for line segments, the post I link to above should help with that, as it explains all the bits of code used here. – Jason B. Mar 06 '18 at 18:42