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, \
rightLink, \[IndentingNewLine]deleteLink, del, pairs}\),
",", "\[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"],
"\n", \(leftLink[seg_] := \
Drop[NestWhileList[lc, {seg},
Length[#] === 1 &], \(-1\)]\), ";",
"\n", \(rightLink[seg_] := \
Drop[NestWhileList[rc, {seg},
Length[#] === 1 &], \(-1\)]\), ";",
"\[IndentingNewLine]",
StyleBox[\( (*delete\ the\ results*) \),
FontWeight->"Plain"],
"\n", \(deleteLink[seg_] /; \
lc[{seg}] === {} := \ \
\[IndentingNewLine]Map[\((del[#] = Sequence[])\) &,
rightLink[seg], {\(-3\)}]\), ";",
"\n", \(deleteLink[seg_] /; \
rc[{seg}] === {} := \ \
\[IndentingNewLine]Map[\((del[#] = Sequence[])\) &,
leftLink[seg], {\(-3\)}]\), ";",
"\[IndentingNewLine]", \(Map[deleteLink,
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]
Thread[{x, \
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
>
>
>