function to draw a 3-point arc

Question

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?

FYI your code does not work in v10.1 under Windows; the Solve fails. — Mr.Wizard, Dec 02 '16 at 23:12
@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. — Stitch, Dec 03 '16 at 00:47
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. — Mr.Wizard, Dec 03 '16 at 03:04
@Mr.Wizard Amazing! "Linked sidebar to the right pointing to your Question" -- and I never paid attention to it before! So convenient! — Stitch, Dec 03 '16 at 03:08
Sjoerd's answer in the second link given by Mr. Wizard does the job in both 2D and 3D. — J. M.'s missing motivation, Dec 10 '16 at 11:25

ubpdqn · Answer 1 · 2016-12-04T02:19:45.190

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;

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. — Stitch, Dec 03 '16 at 15:54
@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 — ubpdqn, Dec 03 '16 at 22:43

Stitch · Accepted Answer · 2016-12-03T16:21:56.867

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]

Comments are welcome!

function to draw a 3-point arc

2 Answers2

Linked