4
$\begingroup$

I am trying to draw a circle in Mathematica with the top of the circle cut off. I use the following code:

ContourPlot[
    x^2 + {y - 3}^2*{Sqrt[{Abs[5 - y]}/{5 - y}]} - 4.6 == 0, 
    {x, -6, 6}, {y, -6, 6}
]

It draws funny lines at the top of the circle. It displays exactly how I would like it in Wolfram Alpha.

Why is this?

Are the extra lines caused by imaginary numbers? If so, can I plot only the reals?

$\endgroup$
  • $\begingroup$ This is what it looks like for me. I can't identify any lines, maybe we get different results. It would help if you said what version of Mathematica you're using and post an image. $\endgroup$ – C. E. Aug 20 '16 at 6:55
  • $\begingroup$ @C.E. My output agrees with yours. I assumed the "funny lines" referred to the tickmark-like dot near the left endpoint. $\endgroup$ – jjc385 Aug 20 '16 at 6:58
4
$\begingroup$

Help and F1 are verry helpfull, look up PlotPoints, WorkingPrecision and friends

ContourPlot[x^2 + {y - 3}^2*{Sqrt[{Abs[5 - y]}/{5 - y}]} - 4.6 == 0, {x, -6, 
6}, {y, -6, 6}]

enter image description here

ContourPlot[x^2 + {y - 3}^2*{Sqrt[{Abs[5 - y]}/{5 - y}]} - 4.6, {x, -6, 
6}, {y, -6, 6}]

enter image description here

enter image description here

Table[ContourPlot[x^2 + {y - 3}^2*{Sqrt[{Abs[5 - y]}/{5 - y}]} - 4.6 == 0,  
{x, -6, 6}, {y, -6, 6}, PlotPoints -> pp], {pp, {15, 20, 25}}]

enter image description here

$\endgroup$
  • $\begingroup$ I'm interested in why PlotPoints is an issue here. Is it indeed because of the imaginary numbers, as the OP suggests? $\endgroup$ – jjc385 Aug 20 '16 at 7:20
3
$\begingroup$

Similarly to the edit I made to my answer to your previous question, revising the condition solves the problem at hand:

ContourPlot[If[Abs[y] < 5, #, Null]& @(x^2 + {y - 3}^2 - 4.6) == 0, {x,-6,6}, {y, -6, 6}]

Note that in this case, it would probably be even more elegant to use RegionFunction:

ContourPlot[x^2 + {y - 3}^2 - 4.6 == 0, {x, -6, 6}, {y, -6, 6}, RegionFunction -> Function[{x, y}, y < 5]]

I've not fully investigated the funny lines in the plot from your code, but they do seem to arise from the original exclusion condition.

Please also take note of the note on parentheses I left in my answer to your previous question:

Stylistic/ syntactic note

Note that although there aren't any errors generated here, curly braces are not interpreted as parentheses in Mathematica. You should use parentheses instead.

$\endgroup$
3
$\begingroup$

One could use ConditionalExpression to restrict the Sqrt[..] expression to its natural domain (i.e., where it is real-valued).

ContourPlot[
 x^2 + (y - 3)^2 * ConditionalExpression[Sqrt[Abs[5 - y]/(5 - y)], y <= 5] - 4.6 == 0,
 {x, -6, 6}, {y, -6, 6}]

Mathematica graphics

Or you could define your own, standard, real-variable square root function like sqrt[] below:

sqrt[x_?NonNegative] := Sqrt[x];
ContourPlot[
 x^2 + (y - 3)^2*sqrt[Abs[5 - y]/(5 - y)] - 4.6 == 0,
 {x, -6, 6}, {y, -6, 6}]
(*  same as above *)

P.S. Braces {} make lists (List); parentheses () are for grouping. Many Mathematica functions handle lists of a expressions in an automatic way, which luckily in this case led to a result that agreed with expectations. However, it doesn't always work out that way.

$\endgroup$
3
$\begingroup$

Another option you have available is to use the optional third argument of Circle to limit the circle to an arc. You can combine this with Solve to find the intersection points initially. It requires a little calculation to translate intersection points into arc angles but it does avoid defining potentially very complicated functions for contour plots and this method is completely general.

Initial graphic using whole circles rather than arcs: enter image description here

Function to calculate arc angles from limiting coordinates and circle centre:

LimitAngles[{pstart_, pend_}, center_: {0, 0}] := Module[{a1, a2},
  {a1, a2} = ArcTan @@@ ((# - center) & /@ {pstart, pend});
  If[a2 < a1, a2 += 2 \[Pi]];
  {a1, a2}
  ]

Solve to find intersection points:

sol1 = Sort[NSolve[
  {x, y} \[Element] Circle[{0, 0}, 5] && 
  {x, y} \[Element] Circle[{0, -3}, Sqrt[4.6]],
 {x, y}][[;; , ;; , 2]]];
sol2 = Sort[NSolve[
  {x, y} \[Element] Circle[{0, 0}, 5] && 
  {x, y} \[Element] Circle[{-4, 0}, Sqrt[2.]], 
{x, y}][[;; , ;; , 2]]];

Final graphic with circles limited to arcs:

Graphics[{
  Circle[{0, 0}, 5, LimitAngles[{sol1[[2]], -sol2[[2]]}]],
  Circle[{0, 0}, 5, LimitAngles[{-sol2[[1]], -sol1[[1]]}]],
  Circle[{0, 0}, 5, LimitAngles[{-sol1[[2]], sol2[[2]]}]],
  Circle[{0, 0}, 5, LimitAngles[{sol2[[1]], sol1[[1]]}]]
  Circle[{0, -3}, Sqrt[4.6], LimitAngles[Reverse@sol1, {0, -3}]],
  Circle[{0, 3}, Sqrt[4.6], LimitAngles[Reverse@-sol1, {0, 3}]],
  Circle[{-4, 0}, Sqrt[2.], LimitAngles[sol2, {-4, 0}]],
  Circle[{4, 0}, Sqrt[2.], LimitAngles[-sol2, {4, 0}]]
  }]

enter image description here

$\endgroup$
  • $\begingroup$ beautiful image~ some sort of similar to batman's logo ;) $\endgroup$ – Wjx Aug 22 '16 at 3:08

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.