# How to retrieve a sub-set of geometric primitives within arbitrary region?

## 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.

These are the points and lines within the region above.

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

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.}}}]}

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};

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):

• @e.doroskevic I have updated the answer. Feb 21, 2017 at 0:34
• 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 Feb 21, 2017 at 9:37

## 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]}
}]
]


## 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.

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

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 =
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]}}]
]


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