Defining a Boolean Region

Question

I'd like to define a new region that is "within direct sight" of a certain point within an existing region.

For the example below, the regions highlighted in red from the black point are not directly visible, and hence should not be included in the region. The remaining blue area should define the new region.

hatpolykite = LaminaData["HatPolykite"];
region = hatpolykite["BoundaryMeshRegion"][1];
SeedRandom[1];
point = RandomPoint[region];
pointgraphics = Point[point]
Show[{RegionPlot[region], Graphics[pointgraphics]}]

I've been trying to create a BooleanRegion to define this new region. The region should be defined by

Are the points within the new region within the first region, i.e. RegionMember[region,point]==True

AND

There is no intersection with the point in the new region and the first region boundary, RegionIntersection[ RegionBoundary[region],Line[ (*all lines between *) RegionBoundary[region], point]]=={}.

The last logical condition is giving me trouble.

Maybe https://mathematica.stackexchange.com/a/290138/72111? – cvgmt Jan 03 '24 at 12:15 — cvgmt, Jan 03 '24 at 12:15

cvgmt · Accepted Answer · 2024-01-04T08:41:34.553

Avoid using White to fill the ouside.

Clear["Global`*"];
hatpolykite = LaminaData["HatPolykite"];
region = hatpolykite["BoundaryMeshRegion"][1];
bd = RegionBounds[region];
{{x1, x2}, {y1, y2}} = ScalingTransform[1.5*{1, 1}, Mean /@ bd]@bd;
space0 = Rectangle[{x1, y1}, {x2, y2}];
obstacles0 = RegionDifference[space0, region];
domain = region;
lines = MeshPrimitives[domain, 1][[;; , 1]];
L = 15;
shadow[loc_, line_] := 
  Polygon[{line[[1]] + L*Normalize[line[[1]] - loc], line[[1]], 
    line[[2]], line[[2]] + L*Normalize[line[[2]] - loc]}];
loc = RandomPoint[region];
regA = Fold[RegionDifference, region, shadow[loc, #] & /@ lines];
regB = RegionDifference[region, regA];
Graphics[{{FaceForm[], EdgeForm[Blue], region}, {Yellow, regA}, {Gray,
    regB}, Red, AbsolutePointSize[5], Point@loc}]

Animation.

Clear["Global`*"];
hatpolykite = LaminaData["HatPolykite"];
region = hatpolykite["BoundaryMeshRegion"][1];
bd = RegionBounds[region];
{{x1, x2}, {y1, y2}} = ScalingTransform[1.2*{1, 1}, Mean /@ bd]@bd;
space0 = Rectangle[{x1, y1}, {x2, y2}];
obstacles0 = RegionDifference[space0, region];
domain = region;
lines = MeshPrimitives[domain, 1][[;; , 1]];
L = 15;
shadow[loc_, line_] := 
  Polygon[{line[[1]] + L*Normalize[line[[1]] - loc], line[[1]], 
    line[[2]], line[[2]] + L*Normalize[line[[2]] - loc]}];
Manipulate[
 Module[{regA, regB},
  regA = Fold[RegionDifference, region, shadow[loc, #] & /@ lines];
  regB = RegionDifference[region, regA]; 
  Graphics[{{FaceForm[], EdgeForm[Blue], region}, {Yellow, 
     regA}, {Gray, regB}, Red, AbsolutePointSize[5], Point@loc}, 
   PlotRange -> {{x1, x2}, {y1, y2}}]], {{loc, {1, 1}}, Locator, 
  TrackingFunction -> Function[pos, loc = RegionNearest[domain]@pos], 
  Appearance -> Graphics[{Red, AbsolutePointSize[10], Point[{0, 0}]}]}]

Original

Clear["Global`*"];
hatpolykite = LaminaData["HatPolykite"];
region = hatpolykite["BoundaryMeshRegion"][1];
bd = RegionBounds[region];
{{x1, x2}, {y1, y2}} = ScalingTransform[1.5*{1, 1}, Mean /@ bd]@bd;
space0 = Rectangle[{x1, y1}, {x2, y2}];
obstacles0 = RegionDifference[space0, region];
domain = region;
lines = MeshPrimitives[domain, 1][[;; , 1]];
L = 15;
shadow[loc_, line_] := 
  Polygon[{line[[1]] + L*Normalize[line[[1]] - loc], line[[1]], 
    line[[2]], line[[2]] + L*Normalize[line[[2]] - loc]}];
Manipulate[
 Graphics[{Orange, space0, AbsolutePointSize[10], Red, Point@loc, 
   Black, shadow[loc, #] & /@ lines, White, obstacles0}, 
  PlotRange -> RegionBounds[domain]], {{loc, {8, 1}}, Locator, 
  TrackingFunction -> Function[pos, loc = RegionNearest[domain]@pos], 
  Appearance -> 
   Graphics[{Red, AbsolutePointSize[10], Point[{0, 0}]}]}]

score 0 · Answer 2 · edited Jan 03 '24 at 15:20

The top ranked answer here doesn't immediately work.

A lower ranked answer does satisfy my requirements.

hatpolykite = LaminaData["HatPolykite"];
region = hatpolykite["BoundaryMeshRegion"][1];
SeedRandom[1];
vertices = hatpolykite["Vertices"][1][[1]];
{minx, maxx} = {Min[Flatten[vertices[[;; , 1]]]], 
   Max[Flatten[vertices[[;; , 1]]]]};
{miny, maxy} = {Min[Flatten[vertices[[;; , 2]]]], 
   Max[Flatten[vertices[[;; , 2]]]]};
reg = region;
point = RandomPoint[region];
reg2 = Line[{point, {x, y}}];
cond = RegionWithin[reg, reg2];
RegionPlot[cond, {x, minx, maxx}, {y, miny, maxy}, MaxRecursion -> 2, 
 PlotPoints -> 30, PlotStyle -> ColorData[97][3], 
 BoundaryStyle -> Directive[Thin, Black], 
 Prolog -> {{Opacity[0.4, Brown], reg}}, 
 Epilog -> {{Black, AbsolutePointSize[6], Point@point}}]

Note that you have renamed loc to point but forgot to change it in RegionPlot, so now the black dot does not match the green solution :) — Domen, Jan 03 '24 at 13:16

Defining a Boolean Region

2 Answers2