Revisions to Divide a geometric region by (many) lines

added 17 characters in body

Source Link

edited Apr 22, 2022 at 15:37

15.3k
37
54

disk = BoundaryDiscretizeGraphics[Disk[]];
blines = MeshPrimitives[disk, 1];
res = Region`Mesh`SplitIntersectingSegments[{lines, blines}];

segments = 
  DeleteDuplicates[
   Sort /@ Flatten[Map[Partition[#, 2, 1] &, res[[2]]], 1]];
coords = res[[1]];

mf = RegionMember[disk];
segments = Select[segments, RegionWithin[disk,(And Line[coords[[#]]]]@@ mf[coords[[#]]]) &];

g = IndexGraph@First[
  ConnectedGraphComponents@
   Graph[Range[Length[coords]], UndirectedEdge @@@ segments, 
    VertexCoordinates -> coords, VertexStyle -> Black, 
    VertexShapeFunction -> "Point", VertexSize -> Tiny]]

Another shape example:

Graphics[
 GraphicsComplex[
  coords, {EdgeForm[Black], Opacity[.7], 
   Thread[{RandomColor[Length[faces]], Polygon /@ faces}]}]]

disk = BoundaryDiscretizeGraphics[Disk[]];
blines = MeshPrimitives[disk, 1];
res = Region`Mesh`SplitIntersectingSegments[{lines, blines}];

segments = 
  DeleteDuplicates[
   Sort /@ Flatten[Map[Partition[#, 2, 1] &, res[[2]]], 1]];
coords = res[[1]];

segments = Select[segments, RegionWithin[disk, Line[coords[[#]]]] &];

g = IndexGraph@First[
  ConnectedGraphComponents@
   Graph[Range[Length[coords]], UndirectedEdge @@@ segments, 
    VertexCoordinates -> coords, VertexStyle -> Black, 
    VertexShapeFunction -> "Point", VertexSize -> Tiny]]

disk = BoundaryDiscretizeGraphics[Disk[]];
blines = MeshPrimitives[disk, 1];
res = Region`Mesh`SplitIntersectingSegments[{lines, blines}];

segments = 
  DeleteDuplicates[
   Sort /@ Flatten[Map[Partition[#, 2, 1] &, res[[2]]], 1]];
coords = res[[1]];

mf = RegionMember[disk];
segments = Select[segments, (And @@ mf[coords[[#]]]) &];

g = IndexGraph@First[
  ConnectedGraphComponents@
   Graph[Range[Length[coords]], UndirectedEdge @@@ segments, 
    VertexCoordinates -> coords, VertexStyle -> Black, 
    VertexShapeFunction -> "Point", VertexSize -> Tiny]]

Another shape example:

Graphics[
 GraphicsComplex[
  coords, {EdgeForm[Black], Opacity[.7], 
   Thread[{RandomColor[Length[faces]], Polygon /@ faces}]}]]

added 61 characters in body

Source Link

edited Apr 22, 2022 at 15:22

halmir

15.3k
37
54

Another approach:

m = Graphics[
  Table[{Hue[RandomReal[]], Opacity[0.8], 
    InfiniteLine[RandomReal[{-1, 1}, {2, 2}]]}, {49}], 
  PlotRange -> {{-1, 1}, {-1, 1}}, Frame -> True]

Discretize it first:

mesh = DiscretizeGraphics[m];

Get internal lines and lines that defined boundaries:

blines = 
  Line[Tuples[
     RegionBounds[
      mesh]][[FindShortestTour[Tuples[RegionBounds[mesh]]][[2]]]]];
lines = MeshPrimitives[mesh, 1];

Split lines:

res = Region`Mesh`SplitIntersectingSegments[{lines, blines}];
segments = 
  DeleteDuplicates[
   Sort /@ Flatten[Map[Partition[#, 2, 1] &, res[[2]]], 1]];
coords = res[[1]];

Construct planar graphs:

g = Graph[Range[Length[coords]], UndirectedEdge @@@ segments, 
  VertexCoordinates -> coords, VertexStyle -> Black, 
  VertexShapeFunction -> "Point", VertexSize -> Tiny]

Find planar faces (need to filter out the outer face):

faces = DeleteCases[PlanarFaceList[g], 
   x_ /; NegativelyOrientedPoints[coords[[x[[;; 3]]]]], 1];

Length[faces]

873

Show[{Graphics[
   GraphicsComplex[
    coords, {Opacity[.7], 
     Thread[{RandomColor[Length[faces]], Polygon /@ faces}]}], 
   PlotRange -> {{-1, 1}, {-1, 1}}], m}]

To split other shapes like a disk:

Show[{Graphics[Disk[]], m}]

disk = BoundaryDiscretizeGraphics[Disk[]];
blines = MeshPrimitives[disk, 1];
res = Region`Mesh`SplitIntersectingSegments[{lines, blines}];

segments = 
  DeleteDuplicates[
   Sort /@ Flatten[Map[Partition[#, 2, 1] &, res[[2]]], 1]];
coords = res[[1]];

segments = Select[segments, RegionWithin[disk, Line[coords[[#]]]] &];

g = First[IndexGraph@First[
  ConnectedGraphComponents@
   Graph[Range[Length[coords]], UndirectedEdge @@@ segments, 
    VertexCoordinates -> coords, VertexStyle -> Black, 
    VertexShapeFunction -> "Point", VertexSize -> Tiny]]

facescoords = DeleteCases[PlanarFaceList[g], GraphEmbedding[g];
faces = PlanarFaceList[g];
max x_= Max[Length /;@ NegativelyOrientedPoints[coords[[x[[;;faces];
faces 3]]]]]= Select[PlanarFaceList[g], 1];(Length[#] != max) &];

Show[{Graphics[
   GraphicsComplex[
    coords, {EdgeForm[Black], Opacity[.7], 
     Thread[{RandomColor[Length[faces]], Polygon /@ faces}]}], 
   PlotRange -> {{-1, 1}, {-1, 1}}], m}]]]

Another approach:

m = Graphics[
  Table[{Hue[RandomReal[]], Opacity[0.8], 
    InfiniteLine[RandomReal[{-1, 1}, {2, 2}]]}, {49}], 
  PlotRange -> {{-1, 1}, {-1, 1}}, Frame -> True]

Discretize it first:

mesh = DiscretizeGraphics[m];

Get internal lines and lines that defined boundaries:

blines = 
  Line[Tuples[
     RegionBounds[
      mesh]][[FindShortestTour[Tuples[RegionBounds[mesh]]][[2]]]]];
lines = MeshPrimitives[mesh, 1];

Split lines:

res = Region`Mesh`SplitIntersectingSegments[{lines, blines}];
segments = 
  DeleteDuplicates[
   Sort /@ Flatten[Map[Partition[#, 2, 1] &, res[[2]]], 1]];
coords = res[[1]];

Construct planar graphs:

g = Graph[Range[Length[coords]], UndirectedEdge @@@ segments, 
  VertexCoordinates -> coords, VertexStyle -> Black, 
  VertexShapeFunction -> "Point", VertexSize -> Tiny]

Find planar faces (need to filter out the outer face):

faces = DeleteCases[PlanarFaceList[g], 
   x_ /; NegativelyOrientedPoints[coords[[x[[;; 3]]]]], 1];

Length[faces]

873

Show[{Graphics[
   GraphicsComplex[
    coords, {Opacity[.7], 
     Thread[{RandomColor[Length[faces]], Polygon /@ faces}]}], 
   PlotRange -> {{-1, 1}, {-1, 1}}], m}]

To split other shapes like a disk:

Show[{Graphics[Disk[]], m}]

disk = BoundaryDiscretizeGraphics[Disk[]];
blines = MeshPrimitives[disk, 1];
res = Region`Mesh`SplitIntersectingSegments[{lines, blines}];

segments = 
  DeleteDuplicates[
   Sort /@ Flatten[Map[Partition[#, 2, 1] &, res[[2]]], 1]];
coords = res[[1]];

segments = Select[segments, RegionWithin[disk, Line[coords[[#]]]] &];

g = First[
  ConnectedGraphComponents@
   Graph[Range[Length[coords]], UndirectedEdge @@@ segments, 
    VertexCoordinates -> coords, VertexStyle -> Black, 
    VertexShapeFunction -> "Point", VertexSize -> Tiny]]

faces = DeleteCases[PlanarFaceList[g], 
   x_ /; NegativelyOrientedPoints[coords[[x[[;; 3]]]]], 1];

Show[{Graphics[
   GraphicsComplex[
    coords, {Opacity[.7], 
     Thread[{RandomColor[Length[faces]], Polygon /@ faces}]}], 
   PlotRange -> {{-1, 1}, {-1, 1}}], m}]

Another approach:

m = Graphics[
  Table[{Hue[RandomReal[]], Opacity[0.8], 
    InfiniteLine[RandomReal[{-1, 1}, {2, 2}]]}, {49}], 
  PlotRange -> {{-1, 1}, {-1, 1}}, Frame -> True]

Discretize it first:

mesh = DiscretizeGraphics[m];

Get internal lines and lines that defined boundaries:

blines = 
  Line[Tuples[
     RegionBounds[
      mesh]][[FindShortestTour[Tuples[RegionBounds[mesh]]][[2]]]]];
lines = MeshPrimitives[mesh, 1];

Split lines:

res = Region`Mesh`SplitIntersectingSegments[{lines, blines}];
segments = 
  DeleteDuplicates[
   Sort /@ Flatten[Map[Partition[#, 2, 1] &, res[[2]]], 1]];
coords = res[[1]];

Construct planar graphs:

g = Graph[Range[Length[coords]], UndirectedEdge @@@ segments, 
  VertexCoordinates -> coords, VertexStyle -> Black, 
  VertexShapeFunction -> "Point", VertexSize -> Tiny]

Find planar faces (need to filter out the outer face):

faces = DeleteCases[PlanarFaceList[g], 
   x_ /; NegativelyOrientedPoints[coords[[x[[;; 3]]]]], 1];

Length[faces]

873

Show[{Graphics[
   GraphicsComplex[
    coords, {Opacity[.7], 
     Thread[{RandomColor[Length[faces]], Polygon /@ faces}]}], 
   PlotRange -> {{-1, 1}, {-1, 1}}], m}]

To split other shapes like a disk:

Show[{Graphics[Disk[]], m}]

disk = BoundaryDiscretizeGraphics[Disk[]];
blines = MeshPrimitives[disk, 1];
res = Region`Mesh`SplitIntersectingSegments[{lines, blines}];

segments = 
  DeleteDuplicates[
   Sort /@ Flatten[Map[Partition[#, 2, 1] &, res[[2]]], 1]];
coords = res[[1]];

segments = Select[segments, RegionWithin[disk, Line[coords[[#]]]] &];

g = IndexGraph@First[
  ConnectedGraphComponents@
   Graph[Range[Length[coords]], UndirectedEdge @@@ segments, 
    VertexCoordinates -> coords, VertexStyle -> Black, 
    VertexShapeFunction -> "Point", VertexSize -> Tiny]]

coords = GraphEmbedding[g];
faces = PlanarFaceList[g];
max = Max[Length /@ faces];
faces = Select[PlanarFaceList[g], (Length[#] != max) &];

Graphics[
 GraphicsComplex[
  coords, {EdgeForm[Black], Opacity[.7], 
   Thread[{RandomColor[Length[faces]], Polygon /@ faces}]}]]

added 1246 characters in body

Source Link

edited Apr 22, 2022 at 15:07

halmir

15.3k
37
54

Another approach:

m = Graphics[
  Table[{Hue[RandomReal[]], Opacity[0.8], 
    InfiniteLine[RandomReal[{-1, 1}, {2, 2}]]}, {49}], 
  PlotRange -> {{-1, 1}, {-1, 1}}, Frame -> True]

Discretize it first:

mesh = DiscretizeGraphics[m];

Get internal lines and lines that defined boundaries:

blines = 
  Line[Tuples[
     RegionBounds[
      mesh]][[FindShortestTour[Tuples[RegionBounds[mesh]]][[2]]]]];
lines = MeshPrimitives[mesh, 1];

Split lines:

res = Region`Mesh`SplitIntersectingSegments[{lines, blines}];
segments = 
  DeleteDuplicates[
   Sort /@ Flatten[Map[Partition[#, 2, 1] &, res[[2]]], 1]];
coords = res[[1]];

Construct planar graphs:

g = Graph[Range[Length[coords]], UndirectedEdge @@@ segments, 
  VertexCoordinates -> coords, VertexStyle -> Black, 
  VertexShapeFunction -> "Point", VertexSize -> Tiny]

Find planar faces (need to filter out the outer face):

faces = DeleteCases[PlanarFaceList[g], 
   x_ /; NegativelyOrientedPoints[coords[[x[[;; 3]]]]], 1];

Length[faces]

873

Show[{Graphics[
   GraphicsComplex[
    coords, {Opacity[.7], 
     Thread[{RandomColor[Length[faces]], Polygon /@ faces}]}], 
   PlotRange -> {{-1, 1}, {-1, 1}}], m}]

To split other shapes like a disk:

Show[{Graphics[Disk[]], m}]

disk = BoundaryDiscretizeGraphics[Disk[]];
blines = MeshPrimitives[disk, 1];
res = Region`Mesh`SplitIntersectingSegments[{lines, blines}];

segments = 
  DeleteDuplicates[
   Sort /@ Flatten[Map[Partition[#, 2, 1] &, res[[2]]], 1]];
coords = res[[1]];

segments = Select[segments, RegionWithin[disk, Line[coords[[#]]]] &];

g = First[
  ConnectedGraphComponents@
   Graph[Range[Length[coords]], UndirectedEdge @@@ segments, 
    VertexCoordinates -> coords, VertexStyle -> Black, 
    VertexShapeFunction -> "Point", VertexSize -> Tiny]]

faces = DeleteCases[PlanarFaceList[g], 
   x_ /; NegativelyOrientedPoints[coords[[x[[;; 3]]]]], 1];

Show[{Graphics[
   GraphicsComplex[
    coords, {Opacity[.7], 
     Thread[{RandomColor[Length[faces]], Polygon /@ faces}]}], 
   PlotRange -> {{-1, 1}, {-1, 1}}], m}]

Another approach:

m = Graphics[
  Table[{Hue[RandomReal[]], Opacity[0.8], 
    InfiniteLine[RandomReal[{-1, 1}, {2, 2}]]}, {49}], 
  PlotRange -> {{-1, 1}, {-1, 1}}, Frame -> True]

Discretize it first:

mesh = DiscretizeGraphics[m];

Get internal lines and lines that defined boundaries:

blines = 
  Line[Tuples[
     RegionBounds[
      mesh]][[FindShortestTour[Tuples[RegionBounds[mesh]]][[2]]]]];
lines = MeshPrimitives[mesh, 1];

Split lines:

res = Region`Mesh`SplitIntersectingSegments[{lines, blines}];
segments = 
  DeleteDuplicates[
   Sort /@ Flatten[Map[Partition[#, 2, 1] &, res[[2]]], 1]];
coords = res[[1]];

Construct planar graphs:

g = Graph[Range[Length[coords]], UndirectedEdge @@@ segments, 
  VertexCoordinates -> coords, VertexStyle -> Black, 
  VertexShapeFunction -> "Point", VertexSize -> Tiny]

Find planar faces (need to filter out the outer face):

faces = DeleteCases[PlanarFaceList[g], 
   x_ /; NegativelyOrientedPoints[coords[[x[[;; 3]]]]], 1];

Length[faces]

873

Show[{Graphics[
   GraphicsComplex[
    coords, {Opacity[.7], 
     Thread[{RandomColor[Length[faces]], Polygon /@ faces}]}], 
   PlotRange -> {{-1, 1}, {-1, 1}}], m}]

Another approach:

m = Graphics[
  Table[{Hue[RandomReal[]], Opacity[0.8], 
    InfiniteLine[RandomReal[{-1, 1}, {2, 2}]]}, {49}], 
  PlotRange -> {{-1, 1}, {-1, 1}}, Frame -> True]

Discretize it first:

mesh = DiscretizeGraphics[m];

Get internal lines and lines that defined boundaries:

blines = 
  Line[Tuples[
     RegionBounds[
      mesh]][[FindShortestTour[Tuples[RegionBounds[mesh]]][[2]]]]];
lines = MeshPrimitives[mesh, 1];

Split lines:

res = Region`Mesh`SplitIntersectingSegments[{lines, blines}];
segments = 
  DeleteDuplicates[
   Sort /@ Flatten[Map[Partition[#, 2, 1] &, res[[2]]], 1]];
coords = res[[1]];

Construct planar graphs:

g = Graph[Range[Length[coords]], UndirectedEdge @@@ segments, 
  VertexCoordinates -> coords, VertexStyle -> Black, 
  VertexShapeFunction -> "Point", VertexSize -> Tiny]

Find planar faces (need to filter out the outer face):

faces = DeleteCases[PlanarFaceList[g], 
   x_ /; NegativelyOrientedPoints[coords[[x[[;; 3]]]]], 1];

Length[faces]

873

Show[{Graphics[
   GraphicsComplex[
    coords, {Opacity[.7], 
     Thread[{RandomColor[Length[faces]], Polygon /@ faces}]}], 
   PlotRange -> {{-1, 1}, {-1, 1}}], m}]

To split other shapes like a disk:

Show[{Graphics[Disk[]], m}]

disk = BoundaryDiscretizeGraphics[Disk[]];
blines = MeshPrimitives[disk, 1];
res = Region`Mesh`SplitIntersectingSegments[{lines, blines}];

segments = 
  DeleteDuplicates[
   Sort /@ Flatten[Map[Partition[#, 2, 1] &, res[[2]]], 1]];
coords = res[[1]];

segments = Select[segments, RegionWithin[disk, Line[coords[[#]]]] &];

g = First[
  ConnectedGraphComponents@
   Graph[Range[Length[coords]], UndirectedEdge @@@ segments, 
    VertexCoordinates -> coords, VertexStyle -> Black, 
    VertexShapeFunction -> "Point", VertexSize -> Tiny]]

faces = DeleteCases[PlanarFaceList[g], 
   x_ /; NegativelyOrientedPoints[coords[[x[[;; 3]]]]], 1];

Show[{Graphics[
   GraphicsComplex[
    coords, {Opacity[.7], 
     Thread[{RandomColor[Length[faces]], Polygon /@ faces}]}], 
   PlotRange -> {{-1, 1}, {-1, 1}}], m}]

Source Link

created Apr 22, 2022 at 14:49

halmir

15.3k
37
54

Loading

Stack Exchange Network

Return to Answer