Is there a way to plot the radius of a circle that passes by three points?

Question

Let $x$ and $y$ be defined such that

x=(((-3 + r) r^2 + a^2 (1 + r)) Csc[θ])/(a (-1 + r))

y=Sqrt[(a^2 (a^2 (1 + r)^2 + 2 r^2 (-3 + r^2)) + 
 a^4 (-1 + r)^2 Cos[θ]^2 - ((-3 + r) r^2 + 
    a^2 (1 + r))^2 Csc[θ]^2)/(a^2 (-1 + r)^2)]

Where for each value of $0<a<1$ and $0<\theta<\frac{\pi}{2}$ we can plot a circle like figure using

ParametricPlot[{{x, y}, {x, -y}}, {r, -10, 10}]

Now, let $R_{s}$ to be the radius of a circle that passes the three points: (A) the top point of the circle like figure, (B) the bottom point of the circle like figure and (C) the right most point of the circle like figure.

My question is there a way to plot $R_{s}$ in terms of $a$ and $\theta$?

For example

ContourPlot[Subscript[R, s], {a, 0, 1}, {θ, 0, π/2}]

How would this look like?

Answer 1

I post this is as a separate answer based on the comment made to my other answer by OP (rather than the title to the question).

The function to find the radius is inefficient and I have used interpolation to approximate the desired contour plot (assuming I have understood the comment correctly):

x[a_, r_, t_] := (((-3 + r) r^2 + a^2 (1 + r)) Csc[t])/(a (-1 + r))

y[a_, r_, t_] := 
 Sqrt[(a^2 (a^2 (1 + r)^2 + 2 r^2 (-3 + r^2)) + 
     a^4 (-1 + r)^2 Cos[t]^2 - ((-3 + r) r^2 + a^2 (1 + r))^2 Csc[
        t]^2)/(a^2 (-1 + r)^2)]
tp[a_, t_] := 
 Quiet@Module[{cs, c, ra, 
    top = u /. Solve[D[y[a, u, t], u] == 0, u, Reals], 
    yz = v /. Solve[y[a, v, t] == 0, v, Reals], xm, pts, tops}, 
   tops = Last[SortBy[{x[a, #, t], y[a, #, t]} & /@ top, Last]];
   xm = Last@Sort[x[a, #, t] & /@ yz];
   pts = {{xm, 0}, tops, {1, -1} tops};
   cs = Circumsphere[pts];
   {c, ra} = List @@ cs;
   ra
   ]
tab = {{##}, tp[##]} & @@@ 
   Tuples[{Range[0.1, 1, 0.1], Range[0.1, Pi/2, 0.1]}];
if = Interpolation[tab];
ContourPlot[if[x, y], {x, 0.1, 1}, {y, 0.1, Pi/2}, 
 ColorFunction -> "Rainbow", PlotLegends -> Automatic, 
 FrameTicks -> {Automatic, Table[{Pi j/180, j}, {j, 10, 90, 10}]}, 
 BaseStyle -> 12, FrameLabel -> {"a", "\[Theta]"}]

Answer 2

points = {{1, 1}, {2, 4}, {5, 1}};
circleParameters[points_] := 
     Block[{x0, y0, r}, {r, x0, y0} /. 
     First@Solve[points /. {x_, y_} :> (x - x0)^2 + (y - y0)^2 == r]]

Module[{r, x0, y0},
 {r, x0, y0} = circleParameters[points];
 Show[
  ContourPlot[(x - x0)^2 + (y - y0)^2 == r, {x, -2, 6}, {y, -2, 6}],
  Graphics@{Red, PointSize@Large, Point@points}]
 ]

Answer 3

x[a_, r_, t_] := (((-3 + r) r^2 + a^2 (1 + r)) Csc[t])/(a (-1 + r))

y[a_, r_, t_] := 
 Sqrt[(a^2 (a^2 (1 + r)^2 + 2 r^2 (-3 + r^2)) + 
     a^4 (-1 + r)^2 Cos[t]^2 - ((-3 + r) r^2 + a^2 (1 + r))^2 Csc[
        t]^2)/(a^2 (-1 + r)^2)]
tp[a_, t_] := Module[{
   cs, c, ra,
   top = u /. Solve[D[y[a, u, t], u] == 0, u, Reals],
   yz = v /. Solve[y[a, v, t] == 0, v, Reals], xm, pts, tops},
  tops = Last[SortBy[{x[a, #, t], y[a, #, t]} & /@ top, Last]];
  xm = Last@Sort[x[a, #, t] & /@ yz];
  pts = {{xm, 0}, tops, {1, -1} tops};
  cs = Circumsphere[pts];
  {c, ra} = List @@ cs;
  Graphics[{Gray, cs, Red, PointSize[0.02], Point[pts], Green, 
    Point[c], {Purple, Line[{c, #}]} & /@ pts, Black, 
    Text[Framed[ra], {xm/2, 0}, {0, -1}]}]
  ]
vis[a_, b_] := 
 Show[Quiet@tp[a, b], 
  ParametricPlot[{#, {1, -1} #} &@{x[a, r, b], y[a, r, b]}, {r, 0, 
    10}], Frame -> True]

Visualizing some examples:

Manipulate[vis[a, b],
 {a, {0.9, 0.95, 0.99}}, {b, Range[0.5, 1.5, 0.2]}]

Answer 4

If you define x and y as functions:

x[a_, r_, t_] := (((-3 + r) r^2 + a^2 (1 + r)) Csc[t])/(a (-1 + r))

y[a_, r_, t_] := Sqrt[(a^2 (a^2 (1 + r)^2 + 2 r^2 (-3 + r^2)) + 
    a^4 (-1 + r)^2 Cos[t]^2 - ((-3 + r) r^2 + a^2 (1 + r))^2
    Csc[t]^2)/(a^2 (-1 + r)^2)]

You can plot the circle with:

Manipulate[
    ParametricPlot[{{x[a, r, t], y[a, r, t]},{x[a, r, t], -y[a, r, t]}},
    {r, -10, 10}, AspectRatio -> 1],
    {{t, 1.}, 0, Pi/2}, {{a, .4}, .01, .99}
]

Answer 5

ok, so you have the parametric plot:

pp = ParametricPlot[{{x, y}, {x, -y}}, {r, -10, 10}]

We can get the desired points from this plot:

pts = Flatten[Cases[pp, Line[pts__] :> pts, Infinity], 1];
xmax = First@MaximalBy[pts, First];
ymax = First@MaximalBy[pts, Last];
ymin = First@MinimalBy[pts, Last];

Having these points we can generate a circumsphere:

circumsphere = Graphics[{
   Circumsphere[{xmax, ymax, ymin}],
   PointSize[Large], Red, Point[{xmax, ymax, ymin}]
   }]

Having the circumsphere, we can get its center:

{center} = Cases[circumsphere, Sphere[center_, r_] :> center, Infinity];

And finally we can plot all of our information together:

Show[
 pp,
 circumsphere,
 Graphics[{
   Line[{center, xmax}],
   Line[{center, ymax}],
   Line[{center, ymin}]
   }],
 PlotRange -> All
 ]