3
$\begingroup$

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

Improve this question
$\endgroup$
2
  • 1
    $\begingroup$ 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}$. $\endgroup$
    – David G. Stork
    Mar 6, 2018 at 17:06
  • $\begingroup$ Possible duplicate of mathematica.stackexchange.com/q/97732/9490 $\endgroup$
    – Jason B.
    Mar 6, 2018 at 17:26

1 Answer 1

Reset to default
3
$\begingroup$

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

Improve this answer
$\endgroup$
2
  • $\begingroup$ 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}] $\endgroup$
    – user5601
    Mar 6, 2018 at 18:19
  • 1
    $\begingroup$ 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. $\endgroup$
    – Jason B.
    Mar 6, 2018 at 18:42

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.