Skip to main content
Commonmark migration
Source Link

###Edit###

Edit

###Edit###

Edit

added 1973 characters in body
Source Link
whuber
  • 20.6k
  • 2
  • 61
  • 113

###Edit###

In comments to the question, Daniel Lichtblau pointed out that a solution that handles a little "noise" or positional error would be advantageous. Here is one using Singular Value Decomposition to project the points to a plane, find a least-squares fit to a circle there, and test the accuracy of the fit relative to the fitted radius. This one makes no effort to look for exceptional cases, because they shouldn't exist: when the points are collinear, the fit ought to find an extremely large radius and conclude that--up to the specified tolerance--the points are indeed concyclic!

Clear[concyclicQ];
concyclicQ[points_List, tol_: 10^-8] := 
 Module[{u, w, v, s2, solution, fit, x, y, r, objective},
  fit[p_] := FindMinimum[objective[{x, y}, r, p], 
    {{x, 0}, {y, 0}, {r,  Mean[Max[#] - Min[#] & /@ Transpose[p]]}}];
  objective[center_, radius_, q_] := Total[(Norm[#] - radius)^2 & /@ (# - center & /@ q)];
  {u, w, v} = SingularValueDecomposition[q = # - Mean[points] & /@ points];
  {s2, solution} = fit[u[[All, 1 ;; 2]]. w[[1 ;; 2, 1 ;; 2]]];
  (Sqrt[s2]/r /. solution) <= tol
  ]

The first two lines define a fitting function fit which estimates reasonable starting values of the center and radius of the circle and uses objective to achieve the least-squares solution. The next line computes the SVD of the points, which is then limited to the eigenspaces of the two largest eigenvalues in the call to fit. The root mean square returned by fit is divided by the fitted radius r. This would be an acceptable value to return, but to make this version compatible with the previous one, I then compare this relative residual error to a user-supplied tolerance: when the error is sufficiently small, it is fair to conclude the points are concyclic.

Examples:

concyclicQ[points]

True

concyclicQ[RandomReal[NormalDistribution[0, 1], {6, 3}]]

False


###Edit###

In comments to the question, Daniel Lichtblau pointed out that a solution that handles a little "noise" or positional error would be advantageous. Here is one using Singular Value Decomposition to project the points to a plane, find a least-squares fit to a circle there, and test the accuracy of the fit relative to the fitted radius. This one makes no effort to look for exceptional cases, because they shouldn't exist: when the points are collinear, the fit ought to find an extremely large radius and conclude that--up to the specified tolerance--the points are indeed concyclic!

Clear[concyclicQ];
concyclicQ[points_List, tol_: 10^-8] := 
 Module[{u, w, v, s2, solution, fit, x, y, r, objective},
  fit[p_] := FindMinimum[objective[{x, y}, r, p], 
    {{x, 0}, {y, 0}, {r,  Mean[Max[#] - Min[#] & /@ Transpose[p]]}}];
  objective[center_, radius_, q_] := Total[(Norm[#] - radius)^2 & /@ (# - center & /@ q)];
  {u, w, v} = SingularValueDecomposition[q = # - Mean[points] & /@ points];
  {s2, solution} = fit[u[[All, 1 ;; 2]]. w[[1 ;; 2, 1 ;; 2]]];
  (Sqrt[s2]/r /. solution) <= tol
  ]

The first two lines define a fitting function fit which estimates reasonable starting values of the center and radius of the circle and uses objective to achieve the least-squares solution. The next line computes the SVD of the points, which is then limited to the eigenspaces of the two largest eigenvalues in the call to fit. The root mean square returned by fit is divided by the fitted radius r. This would be an acceptable value to return, but to make this version compatible with the previous one, I then compare this relative residual error to a user-supplied tolerance: when the error is sufficiently small, it is fair to conclude the points are concyclic.

Examples:

concyclicQ[points]

True

concyclicQ[RandomReal[NormalDistribution[0, 1], {6, 3}]]

False

Source Link
whuber
  • 20.6k
  • 2
  • 61
  • 113

This question of determining whether points form a circle or not can be resolved by solving two sub-problems:

  1. Express the points with just two coordinates rather than $n=3$.

  2. Test whether a collection of points in a plane is concyclic.

We might as well solve the first sub-problem for dimensions $n\ge 3$, because it all works the same: we find an orthonormal basis of $n$-space where the first two basis elements (appropriately translated) span the plane containing the points. Expressing the points in that basis gives the desired 2D coordinates.

An elegant way to identify concyclic planar points is to view them as complex numbers and check them in groups of four each to see whether they have a real cross ratio: if so, each group lies on a common generalized circle (that is, they are either collinear or concyclic). We may pick any three distinct points and, adjoining each of the remaining points in turn, check each of these groups of four. If they are all found to have real cross-ratios, then they all must lie on the (unique) generalized circle determined by those three distinct points.

This plan is executed by concyclicQ, which includes the checks for degenerate situations (such as all points collinear). Some care is needed in the use of Orthogonalize: just a little bit of noise in the data orthogonal to the plane can cause it to conclude the points are not coplanar. To force the points to be considered coplanar, just remove the check If[Length[f] > 2.... (Notice the uses of Chop to reduce the effects of floating point imprecision.)

crossRatio[z1_, z2_, z3_, z4_] := (z1 - z3) (z2 - z4) / ((z2 - z3) (z1 - z4));
concyclicQ[pts_List] /; Length[pts] >= 3 := Module[{points, k, f, g, q, p, test, tol=10^-6},
   (* Step 1: project into the Complex plane *)
   points = Union[pts];                             (* Eliminate any duplicates *)
   q = # - Mean[points] & /@ points;                (* Center the points *)
   f = Select[Chop[Orthogonalize[q, Tolerance -> tol]], Norm[#] > 0 &]; (* Find a basis *)
   If[Length[f] == 0, Return[True]];                (* All are coincident *)
   If[Length[f] == 1, Return[Length[points] <= 2]]; (* Collinear *)
   If[Length[f] > 2, Return[False]];                (* Not coplanar *)
   f = Select[Chop[Orthogonalize[f~Join~IdentityMatrix[Dimensions[points][[2]]]]], 
     Norm[#] > 0 &];                                (* Find an adapted basis *)
   g = ( Inverse[f] )[[All, 1 ;; 2]];               (* Change-of-basis matrix *)
   p = Complex @@@ (q . g);                         (* Change the basis *)

   (* Step 2: test for concyclicality *)
   test = Append[p[[1 ;; 3]], #] & /@ p[[4 ;;]];    (* Test last n-3 against the first 3 *)
   Min[Boole[# \[Element] Reals] & /@ Chop[crossRatio @@@ test, tol]] == 1
   ];
concyclicQ[points_List] := True (* Three points or fewer *)

This code works in greater than three dimensions, too.

Examples:

With[{n = 600, e = Orthogonalize[RandomReal[NormalDistribution[0, 1], {3, 3}]]},
 points = Join[#, ConstantArray[1,  3 - 2]] & /@ (Through[{Cos, Sin}[ 
         RandomReal[{0, 2 \[Pi]}, n]]]\[Transpose]) . e;
]; (* Many random concyclic points *)
concyclicQ[points]

True

q = Append[points, {0, 0, 0}]; (* Throw in a "bad" point *)
concyclicQ[q]

False

concyclicQ[RandomReal[{0, 1}, {4, 3}]] (* Four points in general position *)

False

concyclicQ[{RandomReal[{0, 1}, 4]}\[Transpose] . {{1, 1, 1}}] (* Collinear *)

False

concyclicQ[ConstantArray[ {0, 0, 0}, 4]] (* Coincident *)

True