5
$\begingroup$

Description

I have a geometric configuration consisting of a set of geometric primitives e.g. points and lines. I want to define an area and retrieve all points and lines which are members of its region.

Example

Green is the area denoting the arbitrary region. I am after the points and lines within its boundaries.

Geometry

These are the points and lines within the region above.

Points and Lines within Arbitrary Region

Here is my attempt to solve the problem.

Code

Module[
    {module, lines, points, area},

    (*Module Variable Declaration*)
    module = {{0,0},{0,43},{11,43},{11,45},{15,45},{15,44},{26,44},{26,39},{38,39},{38,34},{50,34},{50,37},{80,37},{80,33},{89,33},{89,4},{75,4},{75,0}};
    points = {{9,32},{6,25},{20,27},{25,23},{25,32},{33,29},{32,23},{37,24},{6,18},{10,9},{19,10},{22,9},{21,17},{23,14},{28,11},{27,18},{36,2},{34,15},{56,30},{68,30},{79,31},{60,25},{60,23},{62,22},{65,25},{72,24},{78,24},{83,21},{58,15},{57,13},{58,11},{59,7},{65,13},{67,19},{75,19},{78,13},{82,16},{68,8}};
    lines = {{{16,42},{25,42}},{{16,39},{25,39}},{{17,37},{17,22}},{{7,30},{7,23}},{{23,32},{23,22}},{{4,34},{30,34}}, {{8,18},{8,8}},{{13,30},{13,8}},{{18,18},{18,8}},{{30,32},{30,11}},{{38,32},{38,6}},{{42,32},{42,6}},{{15,4},{39,4}},{{46,28},{55,35}},{{56,35},{78,35}},{{56,28},{79,28}},{{48,24},{48,12}},{{52,28},{52,10}},{{47,3},{60,3}},{{42,5.5},{62,5.5}},{{47,8.5},{67,8.5}}};

    (*Arbitrary Region*)
    area = {{0,0},{0,43},{11,43},{11,45},{15,45},{15,44},{26,44},{26,39},{38,39},{38,34},{38,0}};

    (*Program*)
    Graphics[{
        {FaceForm @ White, EdgeForm @ {Thick, Gray},Polygon @ module},
        {RGBColor["#339989"], Opacity @ .8, Polygon @ area},
        Point @ points,
        Line @ lines
        }
    ]

    (* Example of all 'points' and 'lines' within 'area'*)
    (*RegionPlot @ (RegionIntersection[Polygon @ area, #] & /@ {Point @ points, Line @ lines})*)
]

I used RegionPlot to visualzie the points and lines deduced after RegionIntersection. However, I cannot retrieve the actual point and line definitions, and if I execute RegionInteresection on its own, the method fails to workout the lines. It also seems to take <10~20 sec to execute :s

I would appreciate communities thoughts on the above, and accept an answer which would solve the above problem. The faster the solution the better. Note, I need a generic solution which could be applied to similar compositions.

Reference

RegionIntersection

Improve this question
$\endgroup$

4 Answers 4

Reset to default
4
$\begingroup$

This is fixed in M11.2. In M11.1 RegionIntersection of a polygon and line didn't simplify. For example (in M11.1):

RegionIntersection[
    Polygon[{{0,0},{0,43},{11,43},{11,45},{15,45},{15,44},{26,44},{26,39},{38,39},{38,34},{38,0}}],
    Line[{{15,4}, {39,4}}]
]

RegionIntersection[Line[{{15, 4}, {39, 4}}], Polygon[{{0, 0}, {0, 43}, {11, 43}, {11, 45}, {15, 45}, {15, 44}, {26, 44}, {26, 39}, {38, 39}, {38, 34}, {38, 0}}]]

The same expression in M11.2:

RegionIntersection[
    Polygon[{{0,0},{0,43},{11,43},{11,45},{15,45},{15,44},{26,44},{26,39},{38,39},{38,34},{38,0}}],
    Line[{{15,4}, {39,4}}]
]

Line[{{{15, 4}, {38, 4}}}]

This means your original code now basically works:

Module[
    {module, lines, points, area},

    (*Module Variable Declaration*)
    module = {{0,0},{0,43},{11,43},{11,45},{15,45},{15,44},{26,44},{26,39},{38,39},{38,34},{50,34},{50,37},{80,37},{80,33},{89,33},{89,4},{75,4},{75,0}};
    points = {{9,32},{6,25},{20,27},{25,23},{25,32},{33,29},{32,23},{37,24},{6,18},{10,9},{19,10},{22,9},{21,17},{23,14},{28,11},{27,18},{36,2},{34,15},{56,30},{68,30},{79,31},{60,25},{60,23},{62,22},{65,25},{72,24},{78,24},{83,21},{58,15},{57,13},{58,11},{59,7},{65,13},{67,19},{75,19},{78,13},{82,16},{68,8}};
    lines = {{{16,42},{25,42}},{{16,39},{25,39}},{{17,37},{17,22}},{{7,30},{7,23}},{{23,32},{23,22}},{{4,34},{30,34}}, {{8,18},{8,8}},{{13,30},{13,8}},{{18,18},{18,8}},{{30,32},{30,11}},{{38,32},{38,6}},{{42,32},{42,6}},{{15,4},{39,4}},{{46,28},{55,35}},{{56,35},{78,35}},{{56,28},{79,28}},{{48,24},{48,12}},{{52,28},{52,10}},{{47,3},{60,3}},{{42,5.5},{62,5.5}},{{47,8.5},{67,8.5}}};

    (*Arbitrary Region*)
    area = {{0,0},{0,43},{11,43},{11,45},{15,45},{15,44},{26,44},{26,39},{38,39},{38,34},{38,0}};

    (*Program*)
    Graphics[{
        {FaceForm @ White, EdgeForm @ {Thick, Gray},Polygon @ module},
        {RGBColor["#339989"], Opacity @ .8, Polygon @ area},
        Point @ points,
        Line @ lines
        }
    ];

    (* Example of all 'points' and 'lines' within 'area'*)
    RegionIntersection[Polygon @ area, #] & /@ {Point @ points, Line @ lines}
]

{Point[{{9, 32}, {6, 25}, {20, 27}, {25, 23}, {25, 32}, {33, 29}, {32, 23}, {37, 24}, {6, 18}, {10, 9}, {19, 10}, {22, 9}, {21, 17}, {23, 14}, {28, 11}, {27, 18}, {36, 2}, {34, 15}}], Line[{{{16., 42.}, {25., 42.}}, {{16., 39.}, {25., 39.}}, {{17., 34.}, {17., 37.}}, {{17., 34.}, {17., 22.}}, {{17., 34.}, {4., 34.}}, {{17., 34.}, {30., 34.}}, {{7., 23.}, {7., 30.}}, {{23., 22.}, {23., 32.}}, {{8., 8.}, {8., 18.}}, {{13., 8.}, {13., 30.}}, {{18., 8.}, {18., 18.}}, {{30., 11.}, {30., 32.}}, {{38., 6.}, {38., 32.}}, {{15., 4.}, {38., 4.}}}]}

Improve this answer
$\endgroup$
3
$\begingroup$ 
Module[{module, lines, points, area, region, pointsinout, linesinout,
memberpoints, lineswithin, indexshared, func, posTrue, thread, 
linesoutside},

module = {{0, 0}, {0, 43}, {11, 43}, {11, 45}, {15, 45}, {15, 
44}, {26, 44}, {26, 39}, {38, 39}, {38, 34}, {50, 34}, {50, 
37}, {80, 37}, {80, 33}, {89, 33}, {89, 4}, {75, 4}, {75, 0}};

points = {{9, 32}, {6, 25}, {20, 27}, {25, 23}, {25, 32}, {33, 
29}, {32, 23}, {37, 24}, {6, 18}, {10, 9}, {19, 10}, {22, 9}, {21,
 17}, {23, 14}, {28, 11}, {27, 18}, {36, 2}, {34, 15}, {56, 
30}, {68, 30}, {79, 31}, {60, 25}, {60, 23}, {62, 22}, {65, 
25}, {72, 24}, {78, 24}, {83, 21}, {58, 15}, {57, 13}, {58, 
11}, {59, 7}, {65, 13}, {67, 19}, {75, 19}, {78, 13}, {82, 
16}, {68, 8}};

lines = {{{16, 42}, {25, 42}}, {{16, 39}, {25, 39}}, {{17, 37}, {17, 
 22}}, {{7, 30}, {7, 23}}, {{23, 32}, {23, 22}}, {{4, 34}, {30, 
 34}}, {{8, 18}, {8, 8}}, {{13, 30}, {13, 8}}, {{18, 18}, {18, 
 8}}, {{30, 32}, {30, 11}}, {{38, 32}, {38, 6}}, {{42, 32}, {42, 
 6}}, {{15, 4}, {39, 4}}, {{46, 28}, {55, 35}}, {{56, 35}, {78, 
 35}}, {{56, 28}, {79, 28}}, {{48, 24}, {48, 12}}, {{52, 28}, {52,
  10}}, {{47, 3}, {60, 3}}, {{42, 5.5}, {62, 5.5}}, {{47, 
 8.5}, {67, 8.5}}};

(*Arbitrary Region*)
area = {{0, 0}, {0, 43}, {11, 43}, {11, 45}, {15, 45}, {15, 44}, {26,
 44}, {26, 39}, {38, 39}, {38, 34}, {38, 0}};

region = Polygon[area];
pointsinout = RegionMember[region, points]; 
linesinout = RegionMember[region, lines];

memberpoints = Pick[points, pointsinout, True];
lineswithin = Pick[lines, And @@@ linesinout, True];
linesoutside = Pick[lines, linesinout, {False, False}] /. {} :> Sequence[];

indexshared = Flatten@Position[linesinout, {True, False} | {False, True}];

posTrue = 
Cases[linesinout, {True, False} | {False, True}] /. {{True,False} :> 1, {False, True} :> 2};

thread = Thread[{indexshared, posTrue}];

func[list_, x_, posT_] := Module[{n, n1, n2, p, sharedline , f},
sharedline = lines[[x]];

Which[posT == 1, p = First@sharedline, posT == 2, p = Last@sharedline];

n = {n1, n2};

n = n /. 
 Maximize[
   EuclideanDistance[p, n], {n \[Element] region, 
    n \[Element] Line[sharedline]}][[2]];

f[1] := (AppendTo[lineswithin, {First@sharedline, n}];
 AppendTo[linesoutside, {n, Last@sharedline}]);  
f[2] := (AppendTo[lineswithin, {n, Last@sharedline}];
 AppendTo[linesoutside, {First@sharedline, n}]);

f[posT];
lineswithin
];

lineswithin = Fold[func[#1, #2[[1]], #2[[2]]] &, lineswithin, thread];

Graphics[{{FaceForm@White, EdgeForm@{Thick, Gray}, 
Polygon@module}, {RGBColor["#339989"], [email protected], 
Polygon@area}, {Blue, PointSize[0.015], Point@memberpoints}, {Red, 
Line@lineswithin}, {Red, 
Point@Complement[points, memberpoints]}, {Darker@Green, 
Line@linesoutside}}]
]

Notice the image (the line is clearly cut into two parts, with the long one (red) inside the region and the small portion in green outside): enter image description here

Improve this answer
$\endgroup$
2
  • $\begingroup$ @e.doroskevic I have updated the answer. $\endgroup$
    – Ali Hashmi
    Feb 21, 2017 at 0:34
  • 1
    $\begingroup$ Hey Ali, upvoted for the work, and will accept it as an answer if nothing else comes up. I am looking for a generic solution $\endgroup$
    – e.doroskevic
    Feb 21, 2017 at 9:37
1
$\begingroup$

Alternative Solution

The code is an example of a solution I used to derive geometric primitives within arbitrary region. Two methods are used; the first method to derive points, and the second method is used to derive lines. The implementation does have its issues as stated below, and is not the most elegant solution but it works. Ideally, I was looking for a single method that would encapsulate the desired operation.

Module[
 {
 module, lines, points, area1, area2,area3, 
 renderRegion,getRegionPoints, getRegionLines
 },
                                
 (*Variable Declaration*)
 module = {{0, 0}, {0, 43}, {11, 43}, {11, 45}, {15, 45}, {15, 44}, {26, 44}, {26, 39}, {38, 39}, {38, 34}, {50, 34}, {50, 37}, {80, 37}, {80, 33}, {89, 33}, {89, 4}, {75, 4}, {75, 0}};
 points = {{9, 32}, {6, 25}, {20, 27}, {25, 23}, {25, 32}, {33, 29}, {32, 23}, {37, 24}, {6, 18}, {10, 9}, {19, 10}, {22, 9}, {21, 17}, {23, 14}, {28, 11}, {27, 18}, {36, 2}, {34, 15}, {56, 30}, {68, 30}, {79, 31}, {60, 25}, {60, 23}, {62, 22}, {65, 25}, {72, 24}, {78, 24}, {83, 21}, {58, 15}, {57, 13}, {58, 11}, {59, 7}, {65, 13}, {67, 19}, {75, 19}, {78, 13}, {82, 16}, {68, 8}};
 lines = {{{16, 42}, {25, 42}}, {{16, 39}, {25, 39}}, {{17, 37}, {17, 22}}, {{7, 30}, {7, 23}}, {{23, 32}, {23, 22}}, {{4, 34}, {30, 34}}, {{8, 18}, {8, 8}}, {{13, 30}, {13, 8}}, {{18, 18}, {18, 8}}, {{30, 32}, {30, 11}}, {{38, 32}, {38, 6}}, {{42, 32}, {42, 6}}, {{15, 4}, {39, 4}}, {{46, 28}, {55, 35}}, {{56, 35}, {78, 35}}, {{56, 28}, {79, 28}}, {{48, 24}, {48, 12}}, {{52, 28}, {52, 10}}, {{47, 3}, {60, 3}}, {{42, 5.5}, {62, 5.5}}, {{47, 8.5}, {67, 8.5}}};
 
 area1 = {{0, 0}, {0, 43}, {11, 43}, {11, 45}, {15, 45}, {15, 44}, {26, 44}, {26, 39}, {38, 39}, {38, 34}, {38, 0}};
 area2 = {{38, 0}, {38, 34}, {50, 34}, {50, 0}};
 area3 = {{50, 0}, {50, 37}, {80, 37}, {80, 33}, {89, 33}, {89, 4}, {75, 4}, {75, 0}};
 
 (*Functions Declaration*)  
 getRegionPoints[area_, points_] := RegionIntersection[Polygon @ area, Point @ points];
 getRegionLines[area_, lines_] := Select[
                                    RegionIntersection[
                                            Polygon @ area, 
                                            Point @ MeshCoordinates @ DiscretizeRegion[Line @ #, MaxCellMeasure -> {"Length" -> 1}]
                                            ] & /@ lines
                                               /. Point -> Line, 
                                    Head @ # == Line &
                                ];

 renderRegion[rgb_, region_] := {RGBColor[rgb], Opacity @ .7, EdgeForm[{Thick, Darker @ Gray}], Polygon @ region};
 
 (*Program*)
 Graphics[{
      renderRegion["#ffffff", module],
      
      Point @ points,
      Line @ lines,
      
      renderRegion["#339989", area1],
      {Red, getRegionPoints[area1, points]},
      {Red, getRegionLines[area1, lines]},
      
      renderRegion["#003153", area2],
      {Yellow, getRegionLines[area2, lines]},
      
      renderRegion["#b08f81", area3],
      {Green, getRegionPoints[area3, points]},
      {Green, getRegionLines[area3, lines]}
   }]   
]

Output

working example

Issues

I.1 - If arbitrary region does not include any lines or points, the functions getRegionPoints and getRegionLines return EmptyRegion which does not render in Graphics crushing the program. Requires, modification of some sort to prevent such behaviour.

Improve this answer
$\endgroup$
2
  • $\begingroup$ nice to see the solution. I posted another answer above as well. +1 $\endgroup$
    – Ali Hashmi
    Feb 22, 2017 at 1:16
  • 1
    $\begingroup$ Hey @Ali I think we cracked it )) i just wish RegionIntersection would have worked. This problem could have been trivial! $\endgroup$
    – e.doroskevic
    Feb 22, 2017 at 1:19
1
$\begingroup$

This is the most general solution i could conceive.

added the SameQ test in Complement to get lines outside the region as well

Module[{module, lines, points, area, region, memberpoints, 
lineswithin,linesoutside},

module = {{0, 0}, {0, 43}, {11, 43}, {11, 45}, {15, 45}, {15, 
44}, {26, 44}, {26, 39}, {38, 39}, {38, 34}, {50, 34}, {50, 
37}, {80, 37}, {80, 33}, {89, 33}, {89, 4}, {75, 4}, {75, 0}};
points = {{9, 32}, {6, 25}, {20, 27}, {25, 23}, {25, 32}, {33, 
29}, {32, 23}, {37, 24}, {6, 18}, {10, 9}, {19, 10}, {22, 9}, {21,
 17}, {23, 14}, {28, 11}, {27, 18}, {36, 2}, {34, 15}, {56, 
30}, {68, 30}, {79, 31}, {60, 25}, {60, 23}, {62, 22}, {65, 
25}, {72, 24}, {78, 24}, {83, 21}, {58, 15}, {57, 13}, {58, 
11}, {59, 7}, {65, 13}, {67, 19}, {75, 19}, {78, 13}, {82, 
16}, {68, 8}};
lines = {{{16, 42}, {25, 42}}, {{16, 39}, {25, 39}}, {{17, 37}, {17, 
 22}}, {{7, 30}, {7, 23}}, {{23, 32}, {23, 22}}, {{4, 34}, {30, 
 34}}, {{8, 18}, {8, 8}}, {{13, 30}, {13, 8}}, {{18, 18}, {18, 
 8}}, {{30, 32}, {30, 11}}, {{38, 32}, {38, 6}}, {{42, 32}, {42, 
 6}}, {{15, 4}, {39, 4}}, {{46, 28}, {55, 35}}, {{56, 35}, {78, 
 35}}, {{56, 28}, {79, 28}}, {{48, 24}, {48, 12}}, {{52, 28}, {52,
  10}}, {{47, 3}, {60, 3}}, {{42, 5.5}, {62, 5.5}}, {{47, 
 8.5}, {67, 8.5}}};
 (*Arbitrary Region*)
 area = {{0, 0}, {0, 43}, {11, 43}, {11, 45}, {15, 45}, {15, 44}, {26,
 44}, {26, 39}, {38, 39}, {38, 34}, {38, 0}};
 region = Polygon[area];

 lineswithin = 
 Thread[RegionBounds[RegionIntersection[region, Line[#]]]] & /@ 
lines //Cases[#, {{_?NumberQ, _?NumberQ}, {_?NumberQ, _?NumberQ}}] &;

 memberpoints = (Transpose@RegionBounds[RegionIntersection[region,Point[#]]] & /@ 
  points) /. patt : {{_, _}, {_, _}} :> patt[[1]] // 
 Cases[#, {_?NumberQ, _?NumberQ}] &;

linesoutside = 
Complement[lines, lineswithin,
SameTest -> (#1[[1]] == #2[[1]] || #1[[1]] == #2[[2]] || #1[[2]] == #2[[2]] &)];

Graphics[{{FaceForm@White, EdgeForm@{Thick, Gray}, 
Polygon@module}, {RGBColor["#339989"], [email protected], 
Polygon@area}, {Blue, PointSize[0.01], Point@memberpoints}, {Red,Line@lineswithin, 
Blue,Line@linesoutside}, {Green,PointSize[0.01],Point@Complement[points, memberpoints]}}]
]

enter image description here

with a change of area as given by the Alternative answer by @e.doroskevic

enter image description here

Improve this answer
$\endgroup$

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.