Re: Re: Smalest enclosing circle

*To*: mathgroup at smc.vnet.net*Subject*: [mg50104] Re: [mg50089] Re: Smalest enclosing circle*From*: DrBob <drbob at bigfoot.com>*Date*: Sun, 15 Aug 2004 03:14:31 -0400 (EDT)*References*: <cfi8tm$4p6$1@smc.vnet.net> <200408140551.BAA15376@smc.vnet.net>*Reply-to*: drbob at bigfoot.com*Sender*: owner-wri-mathgroup at wolfram.com

Like my earlier code, that gives a too-big circle fairly often. It took me a half dozen trials (with three points in each set) to find an example where there were only two points on the circle, and they were not on a diameter. Needs["Graphics`Colors`"] Needs["DiscreteMath`ComputationalGeometry`"] data = RandomArray[NormalDistribution[0, 1], {3, 2}]; hull = data[[ConvexHull@data]]; sq = #.# &; sqDiff = sq[{x, y} - #] &; radius[x_?NumericQ, y_?NumericQ] = Max[sqDiff /@ hull]; Off[FindMinimum::"lstol"] {x1, y1} = Median@hull; {x2, y2} = Mean@hull; soln = FindMinimum[radius[x, y], {x, x1, x2}, {y, y1, y2}, WorkingPrecision -> 20] pt = {x, y} /. Last@soln; r = Sqrt@First@soln; sqDiff /@ hull /. Last@soln Intersection[# - pt & /@ %, hull] Show[Graphics[{PointSize[0.02], Point /@ data, Red, Point@pt, Circle[pt, r], Blue, Line@Join[hull, {First@hull}], Point /@ hull, Yellow, Point /@ {{x1, y1}, {x2, y2}}}], AspectRatio -> Automatic]; Bobby On Sat, 14 Aug 2004 01:51:01 -0400 (EDT), Ray Koopman <koopman at sfu.ca> wrote: > Steve Gray <stevebg at adelphia.net> wrote in message > news:<cfi8tm$4p6$1 at smc.vnet.net>... >> Given n points in the plane, I want to find the smallest >> enclosing circle. Does anyone have Mathematica code to do this? > > My previous code was wrong. > > In[1]:= xy = (* same data as before *) > {{0.6387508898625163, 0.8718650185783614}, > {0.08644342251607252, 0.3294838833708168}, > {0.1870358394343342, 0.8811055141368236}, > {0.3192979185986885, 0.3170715387504082}, > {0.438136771215097, 0.5319294143363852}, > {0.9179114087251881, 0.6613289334430387}, > {0.7341832395247138, 0.8830590740761859}, > {0.9834132497013177, 0.7008775400319166}, > {0.196695901661286, 0.6117008688670413}, > {0.10315109572363866, 0.0506140728297785}}; > > In[2]:= Clear[u,v]; > {r,uvrule} = FindMinimum[Max[Norm[#-{u,v}]&/@xy], > {u,First@Mean@xy,First@Median@xy}, > {v, Last@Mean@xy, Last@Median@xy}] > Out[2]= {0.60531, {u -> 0.389513, v -> 0.583904}} > > > -- DrBob at bigfoot.com www.eclecticdreams.net

**References**:**Re: Smalest enclosing circle***From:*koopman@sfu.ca (Ray Koopman)