Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
1995
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 1995

[Date Index] [Thread Index] [Author Index]

Search the Archive

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
========================================================



  • Prev by Date: Re: Challenge! ....RESULTS...
  • Next by Date: Bivariate Normal Probs.
  • Previous by thread: Re: Find the center!
  • Next by thread: Re: Find the center!