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

$\endgroup$
  • 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 '18 at 17:06
  • $\begingroup$ Possible duplicate of mathematica.stackexchange.com/q/97732/9490 $\endgroup$ – Jason B. Mar 6 '18 at 17:26
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

$\endgroup$
  • $\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 '18 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 '18 at 18:42

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.