# Problem with ContourPlot [Not smooth curve] [closed]

Here is my code

V[x_, y_] := ω^2/2*(x^2 + y^2) - \[Epsilon]*(-(x^6/6) + 5/2*x^4*y^2 - 5/2*x^2*y^4 + y^6/6);
f[x_, y_] := x^2 + y^2;

ω = 1; \[Epsilon] = 1;
h = 1.1;
xmin = 2;

P00 = Show[{{Normal@
ContourPlot[f[x, y] == rad, {x, -xmin, xmin}, {y, -xmin, xmin},
ContourStyle -> {Red, Dashed, Thick}, PlotPoints -> 200,
PerformanceGoal :> "Quality",
RegionFunction -> (V[#1, #2] < h &), MaxRecursion -> 4] /.
Line[{p1_, pp___, p2_}] :>
GeometricTransformation[Line[{p1, pp, p2}],
ReflectionTransform[Cross[p2 - p1], p2]],
ContourPlot[V[x, y] == h, {x, -xmin, xmin}, {y, -xmin, xmin},
ContourStyle -> {Black, Thickness[0.007]}, PlotPoints -> 200,
PerformanceGoal :> "Quality"]}}, FrameLabel -> {"x", "y"},
RotateLabel -> False,
FrameStyle -> Directive[FontSize -> 20, FontFamily -> "Helvetica"],
PlotRange -> All, PlotRangePadding -> None, ImageSize -> 550]


and this is the corresponding output

As you can see, there is an unwanted angle in the red dashed line. It should be smooth as the rest five since the function is symmetrical. I tried to increase the PlotPoints and the MaxRecursion but the problem remains.

Any suggestions on how to fix this?

• The problem is because of the post-processing you are applying to the contour lines. The lowermost "line" is actually two Line primitives which are individually being reflected.
– user484
Jan 2, 2015 at 12:30
• @Rahul So, how can this be fixed? Jan 2, 2015 at 12:31
• I'm not sure. Maybe one of the other solutions in your previous question doesn't have this problem?
– user484
Jan 2, 2015 at 12:33
• it would seem easy enough to just draw those arcs, or construct a function that contours properly without the reflection Jan 2, 2015 at 12:40
• This question appears to be off-topic because it is deals with a problem caused by specific post-processing by the OP and is very localized. Jan 2, 2015 at 14:52

The problem occurs because

z = Normal@ContourPlot[f[x, y] == rad, {x, -xmin, xmin}, {y, -xmin, xmin},
ContourStyle -> {Red, Dashed, Thick}, PlotPoints -> 200,
PerformanceGoal :> "Quality", RegionFunction -> (V[#1, #2] < h &), MaxRecursion -> 4]


contains seven Lines, not six (because the Line representing the original dashed circle has a beginning and an end). This can be seen from

Position[z, Line[y__], Infinity]
{* {{1, 1, 3, 1, 2}, {1, 1, 3, 1, 3}, {1, 1, 3, 1, 4}, {1, 1, 3, 1,
5}, {1, 1, 3, 1, 6}, {1, 1, 3, 1, 7}, {1, 1, 3, 1, 8}} *}


From

Table[Length[z[[1, 1, 3, 1, i, 1]]], {i, 2, 8}]
{* {248, 743, 769, 687, 738, 722, 448} *}


it is evident that the first and last of the Lines must be merged, and the last Line then deleted

z[[1, 1, 3, 1, 2, 1]] = Join[z[[1, 1, 3, 1, 8, 1]], z[[1, 1, 3, 1, 2, 1]]];
z = Delete[z, {1, 1, 3, 1, 8}]


With z thus modified,

Show[{{z /. Line[{p1_, pp___, p2_}] :> GeometricTransformation[Line[{p1, pp, p2}],
ReflectionTransform[Cross[p2 - p1], p2]],
ContourPlot[V[x, y] == h, {x, -xmin, xmin}, {y, -xmin, xmin},
ContourStyle -> {Black, Thickness[0.007]}, PlotPoints -> 200,
PerformanceGoal :> "Quality"]}}, FrameLabel -> {"x", "y"}, RotateLabel -> False,
FrameStyle -> Directive[FontSize -> 20, FontFamily -> "Helvetica"],
PlotRange -> All, PlotRangePadding -> None]


Using ContourPlot for such a simple thing as a circle is like, well, inviting the guys from CSI to find out who has eaten your apple. A circle has a very simple parametric form and you should rather use ParametricPlot for this:

pm = Normal[
ParametricPlot[rad {Cos[phi], Sin[phi]}, {phi, 0, 2 Pi},
PlotStyle -> {Red, Dashed, Thick},
RegionFunction -> (V[#1, #2] < h &)]] /.
Line[{p1_, pp___, p2_}] :>
GeometricTransformation[Line[{p1, pp, p2}],
ReflectionTransform[Cross[p2 - p1], p2]]


It is by magnitudes faster and it really only draws the lines required. Therefore, your Line replacement will instantly work.

Here is another approach, contour just one of the segments, reflect it then make 6 rotated copies of the arc..

 P00 = Show[{{Normal@
ContourPlot[f[x, y] == rad, {x, -xmin, xmin}, {y, -xmin, xmin},
ContourStyle -> {Red, Dashed, Thick}, PlotPoints -> 200,
PerformanceGoal :> "Quality",
RegionFunction -> (V[#1, #2] < h &&
Abs[ArcTan[#2, #1] ] < Pi/6 &),
MaxRecursion -> 4] /.
Line[{p1_, pp___, p2_}] :>
GeometricTransformation[Line[{p1, pp, p2}],
Table[ Composition[RotationTransform[i Pi/3],
ReflectionTransform[Cross[p2 - p1], p2]], {i, 0, 5}]] ,
ContourPlot[V[x, y] == h, {x, -xmin, xmin}, {y, -xmin, xmin},
ContourStyle -> {Black, Thickness[0.007]}, PlotPoints -> 200,
PerformanceGoal :> "Quality"]}}, FrameLabel -> {"x", "y"},
RotateLabel -> False,
FrameStyle -> Directive[FontSize -> 20, FontFamily -> "Helvetica"],
PlotRange -> All, PlotRangePadding -> None, ImageSize -> 550]


this of course relies on a bit of luck that the segment we picked is a smooth one..'

Approach from my comment, getting rid of the reflection and directly contour plotting the outer circles. This is actually slower, but somehow a more satisfying approach..

V[x_, y_] := ω^2/2*(x^2 + y^2) - \[Epsilon]*(-(x^6/6) + 5/2*x^4*y^2 - 5/2*x^2*y^4 + y^6/6);
f[x_, y_] := x^2 + y^2;

ω = 1; \[Epsilon] = 1;
h = 1.1;
xmin = 2;

pint = {x, y} /. NSolve[ V[x, y] == h && f[x, y] == rad , {x, y}];
pp = First@SortBy[pint, Abs[#[[1]]] &];
z = y /. NSolve[ pp[[1]]^2 + (y + pp[[2]])^2 == rad && y^2 > rad] // First;
cp  = -z Table[  {Sin[n Pi/3], Cos[n Pi/3]} , {n, 1, 6}];
P00 = Show[{{Normal@
ContourPlot[
Evaluate[((x - #[[1]])^2 + (y - #[[2]])^2 == rad) & /@ cp],
{x, -xmin, xmin}, {y, -xmin, xmin},
ContourStyle -> {{Red, Dashed, Thick}}, PlotPoints -> 200,
PerformanceGoal :> "Quality",
RegionFunction -> (V[#1, #2] < h &), MaxRecursion -> 4],
ContourPlot[V[x, y] == h, {x, -xmin, xmin}, {y, -xmin, xmin},
ContourStyle -> {Black, Thickness[0.007]}, PlotPoints -> 200,
PerformanceGoal :> "Quality"]}}, FrameLabel -> {"x", "y"},
RotateLabel -> False,
FrameStyle -> Directive[FontSize -> 20, FontFamily -> "Helvetica"],
PlotRange -> All, PlotRangePadding -> None, ImageSize -> 550]


(the result is identical to @bbgodfry's result so I wont bother posting the graphic.)