Re: Find the center!
- To: mathgroup at christensen.cybernetics.net
- Subject: [mg1129] Re: Find the center!
- From: Jorma.Virtamo at vtt.fi (Jorma Virtamo)
- Date: Wed, 17 May 1995 02:19:13 -0400
Gottfried Mayer-Kress <gmk at pegasos.ccsr.uiuc.edu> wrote:
>
> O.k. here is the problem:
>
> There are a bunch of points in 3-space and they are supposed to be
> scattered around the surface of a sphere. You want to find the
> center of the sphere and the radius.
>
> NB: The data are noisy (about 2% of the radius) and only cover a patch
> on the sphere.
>
> I think I have a reasonable solution, but maybe someone knows of some
> real elegant method?
>
Try this one:
In[1]:=
center[pts_] := Module[ {R,r=Plus@@pts/Length[pts]},
{ R = Inverse[ Plus@@(Outer[Times,#-r,#-r]& /@ pts) ].
Plus@@(#.#(#-r)& /@ pts)/2,
Sqrt[Plus@@((#-R).(#-R)& /@ pts)/Length[pts]] } ]
The function returns the center of the sphere and its radius.
The derivation of the formula is left as an excercise.
Example:
--------
Define a function which first normalizes a given vector and
then multiplies the radius by a random coefficient close to one.
In[2]:=
rndnrm[x_] := (.98+.04Random[])x/Sqrt[x.x]
Then we generate a set of 10 sample points which are approximately
located on a unit sphere with center at the point {1,2,3}:
In[3]:=
points = ({1,2,3}+#)& /@ rndnrm /@ Table[Random[]-.5,{10},{3}];
The center function finds the center and radius:
In[4]:=
center[points]
Out[4]=
{{1.00544, 2.00315, 2.99887}, 0.998289}
-- Jorma Virtamo
========================================================
Jorma Virtamo
VTT Information Technology / Telecommunications
P.O. Box 1202, FIN-02044 VTT, Finland
Phone: +358 0 456 5612
Fax: +358 0 455 0115
email: jorma.virtamo at vtt.fi
========================================================