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$ Commented Mar 6, 2018 at 17:06
  • $\begingroup$ Possible duplicate of mathematica.stackexchange.com/q/97732/9490 $\endgroup$ Commented 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$ Commented 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$ Commented Mar 6, 2018 at 18:42

Your Answer

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

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.