4
$\begingroup$

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.

enter image description here

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?

$\endgroup$
2
$\begingroup$

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]"}]

enter image description here

$\endgroup$
  • $\begingroup$ Why does this error appear "ContourPlot::optx : Unknown option PlotLegends"? $\endgroup$ – MrDi Dec 4 '16 at 12:20
  • $\begingroup$ @MrDi what version of Mma are you using? I used version 11.0. $\endgroup$ – ubpdqn Dec 4 '16 at 12:21
  • $\begingroup$ I am using Mathematica 7 $\endgroup$ – MrDi Dec 4 '16 at 12:22
  • $\begingroup$ Is this the reason its not working? $\endgroup$ – MrDi Dec 4 '16 at 12:23
  • $\begingroup$ @MrDi I am sorry I did not appreciate this. Remove PlotLegend and you should get plot. I suggest playing around, I am off to bed. :) $\endgroup$ – ubpdqn Dec 4 '16 at 12:24
4
$\begingroup$
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}]
 ]

enter image description here

$\endgroup$
2
$\begingroup$
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]}]

enter image description here

$\endgroup$
  • $\begingroup$ Thank you for response. What I am asking for is a contour plot of $R_{s}$ in terms of $a$ and $\theta$. See this picture i.imgur.com/fj9LwFI.png of a plot from a paper where the authors plot $R_{s}$. In the picture $i$ represents $\theta$ measured in degrees and $a/M$ represents $a$. $\endgroup$ – MrDi Dec 4 '16 at 11:31
0
$\begingroup$

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}
]

enter image description here

$\endgroup$
  • $\begingroup$ Thank you for response but this is not what I am asking for. I want to plot the radius of a circle that passes by the three points (A), (B) and (C). $\endgroup$ – MrDi Dec 3 '16 at 3:03
0
$\begingroup$

ok, so you have the parametric plot:

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

Mathematica graphics

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}]
   }]

Mathematica graphics

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
 ]

Mathematica graphics

$\endgroup$
  • $\begingroup$ Thank you for response. What I am asking for is a contour plot of $R_{s}$ in terms of $a$ and $\theta$. See this picture i.imgur.com/fj9LwFI.png of a plot from a paper where the authors plot $R_{s}$. In the picture $i$ represents $\theta$ measured in degrees and $a/M$ represents $a$. $\endgroup$ – MrDi Dec 4 '16 at 11:30
  • $\begingroup$ @MrDi OK, but now that you know how to retrieve $R_s$ for parameters $(a, \theta)$, perhaps you can also create the contour plot. Step 1) Turn this solution into a function, 2) Give it to ContourPlot. $\endgroup$ – C. E. Dec 4 '16 at 12:12
  • $\begingroup$ I did but it takes very long and no result shows up. Did you try it? Did you get similar result? $\endgroup$ – MrDi Dec 4 '16 at 12:14
  • $\begingroup$ @MrDi It's not really built to be fast, I would first try to generate a table of values in the format required by ListContourPlot. I'd inspect the table to see that the values look right, and then I'd use ListContourPlot instead. I have not tried it. $\endgroup$ – C. E. Dec 4 '16 at 12:25
  • $\begingroup$ @MrDi From your comment to ubpdqn we now know why this isn't working for you; you are using Mathematica 7 and Circumsphere requires at least Mathematica 10. (Always mention this when you ask a question, since that version is more than eight years old now.) $\endgroup$ – C. E. Dec 4 '16 at 13:02

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.