Re: Smalest enclosing circle
- To: mathgroup at smc.vnet.net
- Subject: [mg50068] Re: [mg50062] Smalest enclosing circle
- From: DrBob <drbob at bigfoot.com>
- Date: Sat, 14 Aug 2004 01:50:16 -0400 (EDT)
- References: <NDBBJGNHKLMPLILOIPPOGEHEECAA.djmp@earthlink.net>
- Reply-to: drbob at bigfoot.com
- Sender: owner-wri-mathgroup at wolfram.com
> You know, it was not immediately obvious to me that two points should be on
> the circle.
If there's only one point on a circle that encloses all the points, the radius can shrink while moving the center directly toward that point. That can continue smoothly until the circle touches another point. If the initial point was not well chosen, the result isn't necessarily optimal, but it's better than the initial circle that goes through only one point.
I see no way to take advantage of this, but we CAN use ConvexHull to do some of the work (if that happens to be more efficient):
Needs["DrawGraphics`DrawingMaster`"]
Needs["DiscreteMath`ComputationalGeometry`"]
data = RandomArray[NormalDistribution[0, 1], {12, 2}];
hull = data[[ConvexHull@data]];
sq = #.# &;
radius[x_?NumericQ, y_?NumericQ] := Sqrt@Max[sq[{x, y} - #] & /@ hull]
Off[FindMinimum::"lstol"]
soln = FindMinimum[radius[x, y], {x, 0}, {y, 0}, WorkingPrecision -> 20]
pt = {x, y} /. Last@soln;
r = First@soln;
Draw2D[{PointSize[0.02], Point /@ data,
Red, Point@pt, Circle[pt, r], Blue, Point /@ hull}, AspectRatio -> Automatic]
Nice picture, huh?
Two or more "hull" points will be on the circle each time. I see three on the circle fairly often, in fact; but I'm sure that's an optical conclusion.
Bobby
On Fri, 13 Aug 2004 23:26:34 -0400, David Park <djmp at earthlink.net> wrote:
> Thanks, Bobby, for being such a promoter of DrawGraphics. (I wonder if the
> next major version of Mathematica will make it obsolete.)
>
> You know, it was not immediately obvious to me that two points should be on
> the circle. But that's a neat solution. You really are a Mathematica wiz!
>
> David Park
> djmp at earthlink.net
> http://home.earthlink.net/~djmp/
>
> From: DrBob [mailto:drbob at bigfoot.com]
To: mathgroup at smc.vnet.net
>
> For instance:
>
> Needs["DrawGraphics`DrawingMaster`"]
> data = RandomArray[NormalDistribution[0, 1], {5, 2}];
> sq = #.# &;
> radius[x_?NumericQ, y_?NumericQ] := Sqrt@Max[sq[{x, y} - #] & /@ data]
> Off[FindMinimum::"lstol"]
> soln = FindMinimum[radius[x, y], {x, 0}, {y, 0}, WorkingPrecision -> 20]
> pt = {x, y} /. Last@soln;
> r = First@soln;
> Draw2D[{PointSize[0.02], Point /@ data, Red,
> Point@pt, Circle[pt, r]}, AspectRatio -> Automatic]
>
> I used DrawGraphics only to draw the picture. That's on David Park's
> mathematica page at
>
> http://home.earthlink.net/~djmp/Mathematica.html
>
> Each time I resample, the resulting circle encloses all the points and two
> points are ON the circle, as I would expect.
>
> Bobby
>
> On Fri, 13 Aug 2004 05:56:28 -0400 (EDT), Steve Gray <stevebg at adelphia.net>
> wrote:
>
>> Given n points in the plane, I want to find the smallest
>> enclosing circle. Does anyone have Mathematica code to do this?
>> I will be grateful for any tips.
>>
>> Steve Gray
>>
>>
>>
>
>
>
> --
> DrBob at bigfoot.com
> www.eclecticdreams.net
>
>
>
>
>
>
--
DrBob at bigfoot.com
www.eclecticdreams.net