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)
- Re: Smalest enclosing circle