4
$\begingroup$

I've been using Wolfram Engine 14.3 for a personal project, one part of which required finding the center-point of a circle in 3D space when given the coordinate-triples of three points on the circle's boundary (see below). I followed the steps in this Mathematics Stack Exchange post but wound up with extremely long expressions that were tricky to simplify (as referenced in my first question about simplification here and my second question about simplification here). The user @azerbajdzan suggested I post a question specifically about finding the center-point as they had a better way to solve it that did not require all the tedious simplification steps.

The three points on the circle have the following coordinates:

pointA = {
    r/Sqrt[3]*(Sqrt[2]*Q*(2 - U^2) + 2 - Sqrt[2]/4*c*U^2)/(Q*(2 - U^2) - 2), 
    r/Sqrt[1]*((c*(Q - 1) - 1)*U)                        /(Q*(2 - U^2) - 2), 
    r/Sqrt[6]*(Sqrt[2]*Q*(2 - U^2) + 2 - Sqrt[2]/4*c*U^2)/(Q*(2 - U^2) - 2)
}

pointB = {
    r/Sqrt[3]*(Sqrt[2]*Q*(1 - U^2) + 3 - 1/2*c*(1 + U^2))/(Q*(1 - U^2) - 2), 
    r/Sqrt[1]*(-(1 + c)*U)                               /(Q*(1 - U^2) - 2), 
    r/Sqrt[6]*(Sqrt[2]*Q*(1 - U^2)*(1 + 2*c*Q) + 2*c)    /(Q*(1 - U^2) - 2)
}

pointC = {
    r/Sqrt[3]*(Sqrt[2]*Q*(1 - U^2) + 1 + c*(Sqrt[2]*Q*(1 - U^2) + 1))/(Q*(1 - U^2) - 2), 
    r/Sqrt[1]*(-(1 + c)*U)                                           /(Q*(1 - U^2) - 2), 
    r/Sqrt[6]*(Sqrt[2]*Q*(1 - U^2) + 4 + c*((1/2 + Q)*(1 - U^2) - 2))/(Q*(1 - U^2) - 2)
}

where r is a positive real number, U is a real number in the interval $[-1, 1]$, c is a real number in the interval $[0, 1]$, and Q := (2 - Sqrt[2])/4.

$\endgroup$
0

4 Answers 4

8
$\begingroup$

The center of a circle in 3D can be calculated from equations of (squared) distances and coplanar requirement. This method does not suffer from producing too complicated formulas that are hard to simplify.

I am not sure why method in another OP question produces such convoluted formulas (although they are correct too).

Q = (2 - Sqrt[2])/4;

aa = {r/Sqrt[
      3]*(Sqrt[2]*Q*(2 - U^2) + 2 - Sqrt[2]/4*c*U^2)/(Q*(2 - U^2) - 2),
    r/Sqrt[1]*((c*(Q - 1) - 1)*U)/(Q*(2 - U^2) - 2), 
   r/Sqrt[6]*(Sqrt[2]*Q*(2 - U^2) + 2 - 
       Sqrt[2]/4*c*U^2)/(Q*(2 - U^2) - 2)};

bb = {r/Sqrt[
      3]*(Sqrt[2]*Q*(1 - U^2) + 3 - 1/2*c*(1 + U^2))/(Q*(1 - U^2) - 2),
    r/Sqrt[1]*(-(1 + c)*U)/(Q*(1 - U^2) - 2), 
   r/Sqrt[6]*(Sqrt[2]*Q*(1 - U^2)*(1 + 2*c*Q) + 2*c)/(Q*(1 - U^2) - 2)};

cc = {r/Sqrt[
      3]*(Sqrt[2]*Q*(1 - U^2) + 1 + 
       c*(Sqrt[2]*Q*(1 - U^2) + 1))/(Q*(1 - U^2) - 2), 
   r/Sqrt[1]*(-(1 + c)*U)/(Q*(1 - U^2) - 2), 
   r/Sqrt[6]*(Sqrt[2]*Q*(1 - U^2) + 4 + 
       c*((1/2 + Q)*(1 - U^2) - 2))/(Q*(1 - U^2) - 2)};

circleCenter[a_, b_, c_] := 
 Block[{dist = 
    SquaredEuclideanDistance @@@ Tuples[{{aa, bb, cc}, {{x, y, z}}}] /. 
     Abs -> Identity, eq}, 
  eq = Equal @@ dist && CoplanarPoints[{a, b, c, {x, y, z}}];
  SolveValues[eq, {x, y, z}][[1]]]

Factor[#, Extension -> Sqrt[2]] & /@ 
  circleCenter[aa, bb, cc] // FullSimplify

enter image description here

$\endgroup$
4
$\begingroup$

3 points on a circle determine 2 secants. The center of the circle is the intersection of 2 lines through the mid points of the secants and perpendicular to the secants.

Given 2 points p1,p2, a line with parameter t trough the midpoints of p1,p2 is given by:

midper[pa_, pb_, t_] := (pa + pb)/2 + t {{0, -1}, {1, 0}} . (pa - pb);

Here is an example:

{p1, p2, p3} = RandomReal[{-1, 1}, {3, 2}];
mid = midper[p1, p2, lam1] /. 
   Solve[{midper[p1, p2, lam1] == midper[p2, p3, lam2]}, {lam1, 
      lam2}][[1]];
Graphics[{Circle[mid, Norm[mid - p1]], Red, Point[mid]}, Axes -> True]

![enter image description here

$\endgroup$
1
$\begingroup$
sol = Solve[{μ1 + μ2 + μ3 == 
      1, (1 - 2 μ1)*r1 . r1 - 2 μ2*r2 . r1 - 
       2 μ3*r3 . r1 == -2 μ1*r1 . r2 + (1 - 2 μ2)*
        r2 . r2 - 2 μ3*r3 . r2 == -2 μ1*r1 . r3 - 
       2 μ2*r2 . r3 + (1 - 2 μ3)*
        r3 . r3}, {μ1, μ2, μ3}] // First;
center = μ1*r1 + μ2*r2 + μ3*r3 /. sol // Simplify
center /. {r1 -> pointA, r2 -> pointB, r3 -> pointC} /. 
  Q -> (2 - Sqrt[2])/4 // Simplify
{r1, r2, r3} = {{x1, y1, z1}, {x2, y2, z2}, {x2, y3, z3}};
(r1 - center) . (r1 - center) == (r2 - center) . (r2 - 
     center) == (r3 - center) . (r3 - center) // Simplify
CoplanarPoints[{center, r1, r2, r3}] // Simplify
{{x1, y1, z1}, {x2, y2, z2}, {x2, y3, z3}} = 
  RandomReal[{-10, 10}, {3, 3}];
rr = EuclideanDistance[center, r1]; 
Show[
 ParametricPlot3D[
  center + 
   rr*{Cos[t], Sin[t]} . Orthogonalize[{r3 - r1, r2 - r1}], {t, 0, 
   2 π}], 
 Graphics3D[{AbsolutePointSize[8], Point[{r1, r2, r3}], Red, 
   Point[center]}], Boxed -> False]

True

True

enter image description here

$\endgroup$
0
$\begingroup$

This does not deal with symbolic case. However, you can use CircleThrough by rotating the normal to the plane of the three points to the z-axis, then projecting onto xy plane then using CircleThrough then invert rotation (taking care to use correct z coordinate). I use Rodriguez formula for the rotation.

 (* Rodriguez method for rotating vector a to vector b*)
 rod[a_, b_] := 
 Module[{k = Normalize[Cross[a, b]], t = ArcCos[a . b/(Norm[a] Norm[b])], 
   m},
  m = {{0, -k[[3]], k[[2]]}, {k[[3]], 0, -k[[1]]}, {-k[[2]], k[[1]], 
     0}};
  IdentityMatrix[3] + Sin[t] m + (1 - Cos[t]) m . m
  ]

(* Detrmining  centre of circle through 3 points*)

cntr[{u_, v_, w_}] := 
 Module[{vec = Subtract @@@ Partition[{u, v, w}, 2, 1], rot, plan},
  rot = rod[Cross @@ vec, {0, 0, 1}];
  plan = rot . # & /@ {u, v, w};
  Inverse[rot] . 
     Append[#, plan[[1, 3]]] &@(CircleThrough[plan[[All, {1, 2}]]][[1]])
  ]

(* Showing the circle*)
gr[{u_, v_, w_}] := 
 Module[{c = cntr[{u, v, w}], 
   vec = Subtract @@@ Partition[{u, v, w}, 2, 1]},
  ParametricPlot3D[
   c + EuclideanDistance[c, 
      u] (Cos[t] Normalize[c - u] + 
       Sin[t] Normalize[(RotationMatrix[Pi/2, 
            Cross @@ vec] . (c - u))]), {t, 0, 2 Pi}]]

(* Putting all together*) 
vis[u_] := 
 Show[gr[u], 
  Graphics3D[{PointSize[0.02], Point[u], Red, Point[cntr[u]], 
    Opacity[0.3], InfinitePlane[u]}], PlotRange -> Table[{-15, 15}, 3],
   BoxRatios -> Automatic, ImageSize -> 300]

For example:

Grid[Partition[vis /@ Table[RandomReal[10, {3, 3}], 9], 3], 
Frame -> All]

enter image description here

$\endgroup$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.