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/