Re: Interior of a polygon

• To: mathgroup at smc.vnet.net
• Subject: [mg28636] Re: Interior of a polygon
• From: "Allan Hayes" <hay at haystack.demon.co.uk>
• Date: Thu, 3 May 2001 04:28:26 -0400 (EDT)
• References: <9c7n25\$scu@smc.vnet.net>
• Sender: owner-wri-mathgroup at wolfram.com

```Here is some code that seems to deal with simple cases.
It provides an interesting exercise in using Split, NestList and negative
levels.

To read, copy between the asterisk lines  *************** (not including
them) and paste into a Mathematica notebook.

***************
Notebook[{

Cell[CellGroupData[{
Cell[" FillBorder", "Title"],

Cell["Allan Hayes, 2001", "Subsubtitle"],

Cell["\<\
Problem: Given a border represented by a list of integer coordinates, \
fill in the interior.\
\>", "Text"],

Cell["\<\
The following method depends on the nature of the border, for example
- there must be no gaps in the border;
- the border must not cross itself;
- the border must be fairly smooth, without small random projections.\
\
\>", "Text"],

Cell["\<\
Gaps might be closed by using a preliminary repairing function
Self-crossing and rough edges could be allowed for in the code, \
within limits.\
\>", "Text"],

Cell[BoxData[
\(Clear["\<`*\>"]\)], "Input"],

Cell[CellGroupData[{

Cell["Make a border", "Subsubsection"],

Cell[BoxData[
\(\(base = \
Flatten[Table[{i, j}, {i, \(-50\), 50}, {j, \(-50\), 50}],
1];\)\)], "Input"],

Cell[BoxData[{
\(circ[r_, \ d_] :=
Cases[base, \ {x_, y_} /; \
Abs[x^2 + y^2\  - r^2] <= \ d]\), "\n",
\(\(b1 = circ[48, \ 100];\)\), "\n",
\(\(b2 = circ[30, \ 50];\)\)}], "Input"],

Cell[BoxData[
\(\(border = Union[b1, \ b2];\)\)], "Input"],

Cell[BoxData[
\(\(bdgr =
ListPlot[border, \ AspectRatio \[Rule] Automatic, \
PlotStyle \[Rule]
PointSize[ .004], \[IndentingNewLine]Axes \[Rule] False,
Frame \[Rule] True];\)\)], "Input"]
}, Open  ]],

Cell[CellGroupData[{

Cell["Code", "Subsubsection"],

Cell[BoxData[
RowBox[{\(FillBorder[border_]\), ":=", "\[IndentingNewLine]",
RowBox[{"Module", "[",
RowBox[{\({slices, \ segments, slice, leftborder, \
rightborder, \ lc, \ rc, leftLink, \
",", "\[IndentingNewLine]",
StyleBox[\( (*Split\ border\ into\ vertical\ slices*) \),
FontWeight->"Plain"], "\n",

RowBox[{\(slices =
Split[Sort[
border], \ #1[\([1]\)] \[Equal] #2[\([1]\)] &]\),
";", "\n", \(segments = \(\((Split[#, \
Abs[#2[\([2]\)]\  - #1[\([2]\)]] ===
1 &])\) &\) /@ slices\), ";", "\n",

StyleBox[\( (*Index\ the\ slices\ of\ \(\(segments\)\(.\)\
\)*) \),
FontWeight->"Plain"],
"\n", \((Map[\((slice[#[\([1, 1, 1]\)]] = #)\) &,
segments, {\(-4\)}]; \nslice[_] = {})\), ";",
"\[IndentingNewLine]",

StyleBox[\( (*\
get\ the\ left\ and\ right\ borders\ of\ a\ segment\ *) \
\),
FontWeight->"Plain"],
"\n", \(leftborder[
seg_] := \(Append[#, #[\([\(-1\)]\)] + {0,
1}] &\)[\(Prepend[#, \ #[\([1]\)] + {0, \
\(-1\)}] &\)[\[IndentingNewLine]Transpose[
Transpose[seg] + {\(-1\), 0}]]]\), ";",
"\n", \(rightborder[
seg_] := \(Append[#, #[\([\(-1\)]\)] + {0,
1}] &\)[\(Prepend[#, \ #[\([1]\)] + {0, \
\(-1\)}] &\)[\[IndentingNewLine]Transpose[
Transpose[seg] + {1, 0}]]]\), ";",
"\[IndentingNewLine]",

StyleBox[\( (*find\ the\ left\ and\ right\ contiguous\ \
segments\ to\ a\ segment*) \),
FontWeight->"Plain"],
"\n", \(lc[{seg_}] := \
Cases[slice[seg[\([1, 1]\)] - 1], \
s_ /; Intersection[s,
pp = leftborder[seg]] =!= {}, {\(-3\)}]\), ";",
"\n", \(rc[{seg_}] := \
Cases[slice[seg[\([1, 1]\)] + 1], \
s_ /; Intersection[s,
pp = rightborder[seg]] =!= {}, {\(-3\)}]\), ";",
"\[IndentingNewLine]",

StyleBox[\( (*list\ the\ contiguous\ segments\ while\ \
there\ is\ only\ \ one*) \),
FontWeight->"Plain"],
Drop[NestWhileList[lc, {seg},
Length[#] === 1 &], \(-1\)]\), ";",
Drop[NestWhileList[rc, {seg},
Length[#] === 1 &], \(-1\)]\), ";",
"\[IndentingNewLine]",
StyleBox[\( (*delete\ the\ results*) \),
FontWeight->"Plain"],
lc[{seg}] === {} := \ \
\[IndentingNewLine]Map[\((del[#] = Sequence[])\) &,
rc[{seg}] === {} := \ \
\[IndentingNewLine]Map[\((del[#] = Sequence[])\) &,
segments, {\(-3\)}]\), ";", "\n", \(del[s_] = \ s\),
";", "\n", \(newsegments =
DeleteCases[Map[del, \ segments, {\(-3\)}], {}]\), ";",
"\[IndentingNewLine]",

StyleBox[\( (*partition\ the\ slices\ into\ pairs\ of\ \
segments*) \),
FontWeight->"Plain"],
"\n", \(pairs\  =
Map[Partition[#, 2] &, \ newsegments, {\(-4\)}]\), ";",
"\n",

StyleBox[\( (*fill\ in\ between\ the\ members\ of\ pairs*) \
\),
FontWeight->"Plain"],
"\[IndentingNewLine]", \(Replace[
pairs, \[IndentingNewLine]{{___, {x_Integer,
a_}}, {{x_, b_}, ___}} \[RuleDelayed]
Range[a + 1,
b - 1]}], \[IndentingNewLine]{\(-4\)}\
\[IndentingNewLine]]\)}]}], "\[IndentingNewLine]", "]"}]}]], "Input"]
}, Open  ]],

Cell[CellGroupData[{

Cell["Apply code to border", "Subsubsection"],

Cell[CellGroupData[{

Cell[BoxData[
\(\(int = \ FillBorder[border];\) // Timing\)], "Input"],

Cell[BoxData[
\({4.839999999999918`\ Second, Null}\)], "Output"]
}, Open  ]],

Cell[BoxData[
\(\(intgr =
ListPlot[Level[int, \ {\(-2\)}], \
PlotStyle \[Rule] {Hue[0], PointSize[ .01]},
AspectRatio \[Rule] Automatic, \ Frame \[Rule] True,
Axes \[Rule] False];\)\)], "Input"],

Cell[BoxData[
\(\(Show[intgr, bdgr];\)\)], "Input"]
}, Open  ]]
}, Open  ]]
},
FrontEndVersion->"4.1 for Microsoft Windows",
ScreenRectangle->{{0, 1024}, {0, 695}},
WindowSize->{675, 543},
WindowMargins->{{61, Automatic}, {29, Automatic}}
]

***************

--
Allan
---------------------
Allan Hayes
Mathematica Training and Consulting
Leicester UK
www.haystack.demon.co.uk
hay at haystack.demon.co.uk
Voice: +44 (0)116 271 4198
Fax: +44 (0)870 164 0565

"Mariusz Jankowski" <mjkcc at usm.maine.edu> wrote in message
news:9c7n25\$scu at smc.vnet.net...
> Hello,
>
> I am trying to solve the following problem:
>
> Assume you are given a list of integer pairs (coordinates of points on a
> integer grid) denoting the border of a closed contour. I want a list of
ALL
> the interior points (again, in the form of integer pairs).
>
> Thanks for any suggestions, solutions, etc. References to literature are
> also welcome. Please cc my email if posting to newsgroup.
>
> Mariusz
>
>
> ======================================================
> Mariusz Jankowski
> University of Southern Maine
> mjkcc at usm.maine.edu
>
>
>

```

• Prev by Date: RE: Re: LightYear Conversion is Incorrect in Units Package
• Next by Date: Re: ViewPoint and RealTime3D
• Previous by thread: Re: Re: Interior of a polygon
• Next by thread: Re: Interior of a polygon