6
$\begingroup$

This may be too trivial, but I couldn't find a relevant thread on SE. Given 3 points, how one can draw an arc? Of course, I can implement a function like:

arc3[pts_List] := 
  Module[{x0, y0, r, eqns, center, radius, theta1, theta2},
         eqns = Table[(First@pts[[i]] - x0)^2 + (Last@pts[[i]] - y0)^2==r^2, {i, 3}]; 
         sols = Quiet@Solve[eqns, {x0, y0, r}];
         center = {x0, y0} /. sols[[1]];
         radius = Abs[r] /. sols[[1]];
         theta1 = VectorAngle[{1, 0}, First@pts];
         theta2 = VectorAngle[{1, 0}, Last@pts];
         Circle[center, radius, {theta1, theta2}]
        ]

and then call it

Graphics@arc3[{{1, 0.5}, {0, 1}, {-.7, 0.9}}]

But this seems to be too much effort for a standard geometrical primitive. Is there a better way?

$\endgroup$
  • 1
    $\begingroup$ FYI your code does not work in v10.1 under Windows; the Solve fails. $\endgroup$ – Mr.Wizard Dec 2 '16 at 23:12
  • 1
    $\begingroup$ Related: (6526), (10957) $\endgroup$ – Mr.Wizard Dec 2 '16 at 23:21
  • $\begingroup$ @Mr.Wizard re MM 10.1: Interesting, I didn't put a lot of thoughts into the function, but I assumed it must be relatively robust for such a trivial case. Thank you for the links! Will use them and report back. $\endgroup$ – Stitch Dec 3 '16 at 0:47
  • 1
    $\begingroup$ Stitch, please do not misunderstand the primary purpose of my "Related" links; it is not a way to say to you that an answer already exists, or even please try this first, etc. Rather it is for the sake of site organization. When someone, perhaps at a far later time, finds your Question it may be useful to them to also see those now linked. Likewise if someone now goes to either of those Questions they will find a link in the Linked sidebar to the right pointing to your Question, which may be what they actually need. $\endgroup$ – Mr.Wizard Dec 3 '16 at 3:04
  • $\begingroup$ @Mr.Wizard Amazing! "Linked sidebar to the right pointing to your Question" -- and I never paid attention to it before! So convenient! $\endgroup$ – Stitch Dec 3 '16 at 3:08
6
$\begingroup$

Simplification

fun[p_] := 
 Module[{cs = List @@ Circumsphere[p], c, r, u, v, w, reg, rm, 
   regc}, {c, r} = cs;
  {u, v, w} = Sort[Mod[ArcTan @@@ (# - c & /@ p), 2 Pi]];
  reg = {{u, w}, {v, 2 Pi + u}, {w, 2 Pi + v}};
  rm = Abs[Subtract @@@ reg];
  regc = Pick[reg, # == Min[rm] & /@ rm];
  ParametricPlot[c + r {Cos[t], Sin[t]}, {t, ##}, 
     Epilog -> {PointSize[0.03], Red, Point[p], Green, Point[c], Gray,
        Dashed, Circle[c, r]}, AspectRatio -> Automatic, 
     PlotRange -> Table[{-2, 2}, 2], Frame -> True, Axes -> False] & @@@
    regc]

Original Answer

Not efficient but for what it's worth (using Circumsphere):

func[p_] := 
 Module[{cs = List @@ Circumsphere[p], c, r, u, v, w, reg, rm, regc},
  {c, r} = cs;
  {u, v, w} = Sort[Mod[ArcTan @@@ (# - c & /@ p), 2 Pi]];
  reg = ParametricRegion[c + r {Cos[t], Sin[t]}, {{t, ##}}] & @@@ {{u,
       w}, {v, 2 Pi + u}, {w, 2 Pi + v}};
  rm = RegionMeasure /@ reg;
  regc = Pick[reg, # == Min[rm] & /@ rm];
  RegionPlot[regc, 
   Epilog -> {PointSize[0.03], Red, Point[p], Green, Point[c], Gray, 
     Dashed, Circle[c, r]}, AspectRatio -> Automatic, 
   PlotRange -> Table[{-2, 2}, 2]]]

Testing on 10 random triples:

pts = RandomReal[1, {10, 3, 2}];
anim=func/@pts;

enter image description here

$\endgroup$
  • $\begingroup$ Circumsphere is awesome! I didn't know about it. It is much faster than Solve and you don't need to plot with ParamtericPlot. Updating my answer. $\endgroup$ – Stitch Dec 3 '16 at 15:54
  • $\begingroup$ @Stitch Circumsphere is just using a built-in function. The inefficiency relates to getting shortest arc. It would just be easier to do angle subtraction a $\endgroup$ – ubpdqn Dec 3 '16 at 22:43
2
$\begingroup$

Updated based on ubpdqn's brilliant use of Circumsphere. The function is now more than two orders of magnitude faster.

Ok, since it seems like there is no simple form solution based on additional readings of other posts, I am posting the general form of the function I suggested in the question:

arc3v2[pts_List] := 
   Module[{center, radius, theta},
     {center, radius} = List @@ Circumsphere[pts];
     theta = SortBy[Mod[ArcTan @@ (# - center), 2 Pi] & /@ pts, # &];
     {center, radius, {First@theta, Last@theta}}
    ]

Verifying that it works (the function in the original question didn't correctly calculate angles, as VectorAngle is not accounting for quadrants):

pts = {{1, 5}, {-1, .1}, {-.7, -0.1}};
arc = arc3v2[pts];
Show[
  Sequence @@ Table[Graphics[{Red, Disk[pts[[i]], 0.1]}], {i, 3}],
  Graphics[{Green, Disk[arc[[1]], 0.1]}], 
  Graphics[{LightGray, Circle[Sequence @@ Most@arc]}],
  Graphics @ Circle[Sequence @@ arc], 
 Axes -> True]

enter image description here

Comments are welcome!

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.