Re: Two programming challenges
- To: mathgroup at smc.vnet.net
- Subject: [mg14405] Re: Two programming challenges
- From: nfares at aol.com (NFares)
- Date: Sun, 18 Oct 1998 15:10:09 -0400
- Organization: AOL http://www.aol.com
- References: <7040tk$i4t@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
>
>Mathematica Programming Challenge 1
>
>Given several points in the plane, connect these points by line
>segments, resulting in a connected polygonal line that passes through
>all the points and does not intersect itself. Arrange it so that the
>line seems to spiral inwards.
It seems to me that one way to do this is to get the convex hull of the
points, strip those, get the convex hull of the remaining points, strip
those and repeat till all the points are accounted for. Mathematica has
a builty in convex hull algorithm called ConvexHull in the
DiscreteMath`ComputationalGeometry` package. So the implementation then
becomes simple (discussed and shown later).
Note that the above algorithm as described is not the most efficient,
each convex hull takes O(n Log[n]) and we have to do this up to O(n)
times (but usually much less). Therefore the procedure would take up to
O(n^2 Log[n]) times. A more efficient (but longer way) would be to get
the Delaunay triangulation then walk along the outer boundary (while
marking points already passed) then to the next layer and so on. Since
Delaunay triangulation takes O(n Log[n]) operations and an additional
O(n) operations are needed for "walking-in" then this more efficient
method takes O(n Log[n]) operations.
The implementation presented below is not compact, I use intermediate
symbols for clarity and also plot connected points before, during and
after the spiralization. Finally, I use FixedPoint with check for empty
points remaining to be spiralized. The procedure is shown below:
Needs[ "DiscreteMath`ComputationalGeometry`" ] spiralPoints[
xyList:{{_,_}..} ] :=
Module[ {xySpiralOrder, lastConvex,
newPointsToAdd, remainingPoints,
minX, maxX, minY, maxY},
xySpiralOrder = {};
remainingPoints = xyList;
{{minX, maxX}, {minY, maxY}} =
{ {Min[#[[1]]& /@ xyList ], Max[ #[[1]]& /@ xyList]},
{Min[#[[2]]& /@ xyList ], Max[ #[[2]]& /@ xyList]} };
ListPlot[ xyList, PlotJoined -> True,
PlotRange -> {{minX, maxX}, {minY, maxY}} ];
FixedPoint[ (
lastConvex = ConvexHull[ # ];
newPointsToAdd =
Extract[ remainingPoints,
Transpose[ {lastConvex}] ];
xySpiralOrder = Join[ xySpiralOrder, newPointsToAdd ];
ListPlot[ xySpiralOrder, PlotJoined -> True,
PlotRange -> {{minX, maxX}, {minY, maxY}} ];
remainingPoints = Delete[ remainingPoints,
Transpose[ {lastConvex} ] ])&,
remainingPoints,
SameTest -> ((remainingPoints=={})&)];
xySpiralOrder
]
The above procedure can be tested by:
spiralPoints[ Table[ {Random[Real,{-2,2}], Random[Real, {-2,2}]}, {100}
] ]
Regards,
Nabil Fares
Imagineering LLC
NFares at imagineeringLLC.com
http://www.imagineeringLLC.com/