Minimize a solution

Question

I have three points in a 3D space

A(xa,ya,za)
B(xb,yb,zb)
C(xc,yc,zc)

I would like to find the smallest sphere which pass A,B, and C.

(x-xo)^2+(y-yo)^2+(z-zo)^2=R^2

I need to obtain

(xo,yo,zo, R)

First, I consider solving the equal distance.

Solve[{(x - xa)^2 + (y - ya)^2 + (z - za)^2 == 
   R, (x - xb)^2 + (y - yb)^2 + (z - zb)^2 == 
   R, (x - xc)^2 + (y - yc)^2 + (z - zc)^2 == R}, {x, y, z}]

But I do not now how to add it as a condition of a minimization

Minimize[R, ?????]

Update I just add the point that mathematica stucks on direct geometric solution

Solve[{(x - xa)^2 + (y - ya)^2 + (z - za)^2 == R^2,
    (x - xb)^2 + (y - yb)^2 + (z - zb)^2 == R^2,
    (x - xc)^2 + (y - yc)^2 + (z - zc)^2 == R^2, 
    Det[{{z - xa, y - ya, z - za}, {xb - xa, yb - ya, 
    zb - za}, {xc - xa, yc - ya, zc - za}}] == 0},
        {x, y, z, R}]

A sketch: project the three points to the plane, find their circumcircle, and then make the sphere that has that circumcircle as its great circle. — J. M.'s missing motivation, Apr 10 '18 at 05:18
I am not a mathematica expert, I just know Solve and Minimize. But other ideas are welcome. However, I do not think mathematica can do calculate analytical circumcircle. — ar2015, Apr 10 '18 at 05:20
I believe the center of the sphere will lie in the plane containing the points A,B,C and will lie at the intersection of the perpendicular bisectors of the line AB and of the line BC in that plane. That simplifies your minimization problem down to constructing that intersection. — Bill, Apr 10 '18 at 05:35
related (I hope you realize its the same problem..) https://math.stackexchange.com/q/1076177/92921 — george2079, Apr 11 '18 at 03:17

score 1 · Answer 1 · answered Apr 10 '18 at 07:23

1

How about this quite standard way

sol[{xa_, ya_, za_}, {xb_, yb_, zb_}, {xc_, yc_, zc_}] := 
    Solve[{(x0 - xa)^2 + (y0 - ya)^2 + (z0 - za)^2 == 
            R^2, (x0 - xb)^2 + (y0 - yb)^2 + (z0 - zb)^2 == 
            R^2, (x0 - xc)^2 + (y0 - yc)^2 + (z0 - zc)^2 == R^2}, {R, x0, y0},
            Reals]

Select the solution with R > 0

Minimize[R /. #, {x0, y0, z0}] & /@ 
     sol[{1, 2, -1}, {0, 0, 0}, {1, 1, 1}]

(*   (-\[Infinity]  {z0->-\[Infinity],x0->33/10,y0->8/5}
     (3 Sqrt[5/7])/2    {z0->-(3/14),x0->33/10,y0->8/5})   *)

answered Apr 10 '18 at 07:23

Akku14

17,287
14
32

I need the analytical solution. That's my main problem. – ar2015 Apr 10 '18 at 07:26
You can not find an analytical solution. How should Minimize decide, whether the three points line up in one line or not and R would be Infinity. You can get a general solution for R sa = sol[{xa, ya, za}, {xb, yb, zb}, {xc, yc, zc}] which is lengthy, but depends only on z0. Transfer this to C++ and then find the minimum in zo with C++ routines for given {xa, ya, za}, {xb, yb, zb}, {xc, yc, zc}. – Akku14 Apr 10 '18 at 08:03

J. M.'s missing motivation · Answer 2 · 2018-04-11T06:16:55.163

1

Here is an explicit implementation of my idea in the comments. Using Fiedler's technique for determining the circumsphere via the Cayley-Menger matrix:

CayleyMengerMatrix[pts_?MatrixQ] := With[{d = Length[pts] + 1}, 
      SparseArray[{{j_ /; j > 1, 1} :> 1, {1, k_ /; k > 1} :> 1,
                   {j_, k_} /; j != k :> ((#.#) &[pts[[j - 1]] - pts[[k - 1]]])}, {d, d}]]

CircumSphere[pts_?MatrixQ] := Module[{cv, icm, rc},
      icm = -2 Inverse[CayleyMengerMatrix[pts]]; cv = icm[[1, 2 ;;]];
      rc = First[Sqrt[Tr[icm, List]]];
      Sphere[cv.pts/Total[cv], rc/2]]

cs[{{xa_, ya_, za_}, {xb_, yb_, zb_}, {xc_, yc_, zc_}}] =
   Simplify[CircumSphere[{{xa, ya, za}, {xb, yb, zb}, {xc, yc, zc}}]]

where evaluating the last line will give you an explicit closed form formula (whose output I have mercifully omitted), with no guarantees on numerical stability. (Reformulating the resulting formula for stability is left up to you.)

Nevertheless,

BlockRandom[SeedRandom[14344, Method -> "MersenneTwister"];
            pts = TranslationTransform[RandomReal[{-1, 1}, 3]][
                  Normalize /@ RandomVariate[NormalDistribution[], {3, 3}]]];

Graphics3D[{{Opacity[2/3], Sphere @@ cs[pts]}, Triangle[pts], Sphere[pts, 0.02]},
           Boxed -> False]

circumsphere for a 3D triangle

edited Apr 11 '18 at 06:16

answered Apr 11 '18 at 01:28

J. M.'s missing motivation

124,525
11
401
574

Something to adjust: it doesn't work for me.. – user64494 Apr 11 '18 at 05:30
If you can give an explicit example where this doesn't work (apart from degenerate cases like collinear points, which is a known weakness of this approach), I might be able to fix this. – J. M.'s missing motivation Apr 11 '18 at 05:44
Here it is: https://www.dropbox.com/s/4em4atlet4bktfo/sphere.pdf?dl=0 and https://www.dropbox.com/s/z1udyh5gx6a91p3/sphere.nb?dl=0 . – user64494 Apr 11 '18 at 06:14
Ah, it was a variable I forgot I used. Try it now (after evaluating Remove[cs]). – J. M.'s missing motivation Apr 11 '18 at 06:17
cs[{{1, 1, 1}, {1, 1, 1}, {1, 1, 1}}] outputs Sphere[{Indeterminate, Indeterminate, Indeterminate}, Indeterminate] My code works in this case.(for @J.M.) – user64494 Apr 11 '18 at 06:26
1

I said "apart from degenerate cases". ;) As you note yourself, your solution doesn't work to give the generic case ("but the code is running on my comp without any output during long time"). – J. M.'s missing motivation Apr 11 '18 at 06:31
Sorry, your words do not correspond to reality. – user64494 Apr 11 '18 at 06:32
I'll stop responding after this: I presume the user will add a check for degenerate cases since he says "at the end I have to implement the entire method in C++". – J. M.'s missing motivation Apr 11 '18 at 06:34

score 0 · Answer 3 · answered Apr 10 '18 at 06:12

0

In principle,

Minimize[{r,Exists[{x0, y0, 
z0}, {xa, ya, za} \[Element] 
 Sphere[{x0, y0, z0}, r] && {xb, yb, zb} \[Element] 
 Sphere[{x0, y0, z0}, r] && {xc, yc, zc} \[Element] 
 Sphere[{x0, y0, z0}, r]]}, r]

should work, but the code is running on my comp without any output during long time. However, this works well for concrete points, e.g.

Minimize[{r,Exists[{x0, y0, 
z0}, {1, 2, -1} \[Element] 
 Sphere[{x0, y0, z0}, r] && {0, 0, 0} \[Element] 
 Sphere[{x0, y0, z0}, r] && {1, 1, 1} \[Element] 
 Sphere[{x0, y0, z0}, r]]}, r]

$ \left\{\frac{3 \sqrt{\frac{5}{7}}}{2},\left\{r\to \frac{3 \sqrt{\frac{5}{7}}}{2}\right\}\right\}$

answered Apr 10 '18 at 06:12

user64494

26,149
4
27
56

My problem is that I need to move the solution to a C++ code. A especial case will not work for me. At the end I have to implement the entire method in C++. – ar2015 Apr 10 '18 at 06:21
However, to finalize the question, please provide the general method (Minimize of Solve) and I will accept your answer. – ar2015 Apr 10 '18 at 06:23
@ar2015: You may try Compile and CForm to this end. – user64494 Apr 10 '18 at 06:28
Did not understand what you mean. – ar2015 Apr 10 '18 at 08:04

Minimize a solution

3 Answers3