Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.
Table[ContourPlot[y^2 (10-x)==x^3,{x,0,.1},{y,-.1,.1},PlotPoints->5],{k,1,150,10}]

enter image description here

How to get the smooth graph?

When PlotPoints is larger than 500, performance is too slow, however still not good.

enter image description here

enter image description here

share|improve this question
    
increase your plot points? btw. for what do you need k? –  Stefan Jun 27 '13 at 9:50
    
@Stefan PlotPoints -> 500 two slow, however still not good ---! x=0, y should be 0. –  HyperGroups Jun 27 '13 at 9:54
    
i've used 50. still too slow? –  Stefan Jun 27 '13 at 9:57
    
@Stefan but when using PlotPoints->50 output is not the right graph. Performance too slow. –  HyperGroups Jun 27 '13 at 10:00
3  
Try an odd number of PlotPoints. You might also try MaxRecursion->6 or so. Also, I wouldn't generally expect ContourPlot, which samples points on a 2D grid, to perform as well as Plot, which samples points on a 1D grid. –  Mark McClure Jun 27 '13 at 10:18

2 Answers 2

up vote 12 down vote accepted

First, I would not generally expect ContourPlot, which samples points on a 2D grid, to perform as well as Plot, which samples points on a 1D grid. That said, you can improve the plot by ensuring that you sample the function at the origin by simply using an odd number of PlotPoints:

ContourPlot[y^2 (10 - x) == x^3, {x, 0, .1}, {y, -.1, .1},
  PlotPoints -> 25, MaxRecursion -> 6]

enter image description here

To make it clear what's going on here, let's zoom into your image and show the sample points.

{pic, {pts}} = Reap[ContourPlot[
  y^2 (10 - x) == x^3, {x, 0, .1}, {y, -.1, .1}, 
  PlotPoints -> 50,EvaluationMonitor :> Sow[{x, y}], 
  ContourStyle -> {Thick, Blue}]];
Show[{pic, Graphics[{Point[pts], PointSize[Large], Red, Point[{0, 0}]}]},
  PlotRange -> -0.05]

enter image description here

The origin is the large red dot and it is simply missed. Now, here's the same picture with PlotPoints set to 25 and MaxRecursion left at it's default value of 2.

enter image description here

share|improve this answer
    
Nice answer, but what's a 1D grid? –  cormullion Jun 27 '13 at 10:46
    
@cormullion Is grid not an $n$-dimensional concept for arbitrary, positive, integer $n$? As in GridGraph[{5}] or Grid[{{1,2,3,4,5}}]. –  Mark McClure Jun 27 '13 at 10:51

ContourPlot generally works on the principle of the Intermediate Value Theorem, and works best when it can find points for which the function being plotted lies on either side of the contour level (which is hard, for example, for equations of the form f^2 == 0). For convenience I will talk about contours of the form f == 0 and speak about the function changing sign instead of taking values above and below the contour level.

ContourPlot uses PlotPoints to divide the domain initially into rectangular cells. ContourPlot decides which cells contain part of the contour and which contain connected components; in the adaptive refinement step (up to MaxRecursion steps), it also decides which might contain more of the contour, and which are not worth pursuing. In a symmetric graph on a symmetric domain, whether there are an even or an odd number of PlotPoint can make a remarkable difference. So can offsetting the domain to make it slightly asymmetrical.


It might be surprising that one can produce an excellent graph with just PlotPoints -> 2:

ContourPlot[y^2 (10 - x) == x^3, {x, 0, 0.1}, {y, -0.1, 0.1}, 
    PlotPoints -> 2, MaxRecursion -> #] & /@ {2, 4} // GraphicsRow

Good plots with PlotPoints->2

This works for an even number of PlotPoints up to 14 and then fails for 16 or higher, as in the OP. I will return to this later. First I wish illustrate another point made above. The connectedness of the contour seems (naturally) related to the values of the function on the sample grid. If a function does not change sign, then the cell contains a disconnected segment of the contour or no segment. This can change as sample points are added under adaptive refinement. This can be illustrated by manually adding extra sample points (as discussed in this question. Here is the OP's 50-point plot and the same plot with an extra sample point added to each cell straddling the x-axis:

ContourPlot[y^2 (10 - x) == x^3, {x, 0, .1}, {y, -.1, .1}, 
    PlotPoints -> {{50}, #}, MaxRecursion -> 0, ImageSize -> 150, 
    BaseStyle -> Tiny, PlotRange -> {{0, 0.04}, Automatic}, 
    PlotLabel -> Row[{Length@#, " extra points"}]] & /@
  {{}, Table[{x0, 0}, {x0, 0.05/49, 0.1, 0.1/49}]} // GraphicsRow

50 PlotPoints, w & w/o extra sample points

Adaptive refinement slowly connects the components generated by the extra sample points to the curve (MaxRecursion is set to 2, 4, 6):

Table[ContourPlot[y^2 (10 - x) == x^3, {x, 0, .1}, {y, -.1, .1}, 
   PlotPoints -> {{50}, Table[{x0, 0}, {x0, 0.05/49, 0.1, 0.1/49}]}, 
   MaxRecursion -> mr, PlotLabel -> mr, ImageSize -> 150, 
   BaseStyle -> Tiny, PlotRange -> {{0, 0.04}, Automatic}],
 {mr, 2, 6, 2}] // GraphicsRow

Adaptive refinement of extra sample points

I will try to explain what is happening below.


For an even number of PlotPoints up to 14, a very large proportion of the plot domain is empty (all x less than 0.08 or rectangle at least 80% of the area). There must be some threshold that triggers ContourPlot to subdivide the whole domain. In cases of 2, 4,..., 14 points, the first subdivision effectively adds the points corresponding to PlotPoints being set to 3, 5,..., 15 points resp. In the OP's case, a low number of plot points happens to work well because of the symmetry of the plot.

The case of PlotPoints -> 16

The function adaptivePlotGrid[plotpoints, xMax, maxRecursion] is a tool for exploring the adaptive refinement procedure (code below). It shows the orginal sample grid (thin brown lines), the new sample points (red) and the previously generated sample points (light gray) for a succession of refinements.

Here we can see the adaptive refinement working its way back to the origin for PlotPoints -> 16. When an original cell is subdivided at y == 0, the (approximate) contour in that cell is incorporated into the contour plot. We can see that the origin is first incorporated into the plot at step MaxRecursion -> 13; subsequent refinements result in better approximations to the contour.

adaptivePlotGrid[16, 0.09, 15]

<code>PlotPoints -> 16</code>

The case of PlotPoints -> 50

The OP's case is similar to the case of PlotPoints -> 50, but it has many more cells to work through to get back to the origin. The origin is still not reached when the limit of MaxRecursion -> 15 is reached.

Aside: An issue with adding extra sample points is discussed in the linked question. The cells with an extra sample point in them (apparently) will not be subdivided until an adjacent cell is subdivided and the shared side is split. When this happens, the components of the contour on the adjacent cells are joined (assuming the changes in sign of the function at the sample points indicate they join, as in the OP's case).

The case of PlotPoints -> 2

The case of PlotPoints -> 2 may interesting, too. Here we see the initial graph is blank. The first refinement adds the origin (as other points, on and off the x-axis, not shown due to the PlotRange). Then the adaptive refinement is on its way to plotting a more and more accurate contour.

adaptivePlotGrid[2, 0.04, 3]

PlotPoints ->2


adaptivePlotGrid[pp_, maxX_: 0.04, maxMR_: 5] := 
 Module[{pts, mr1 = 0, mr2 = maxMR, dmr = 1},
  pts[mr1 - dmr] = {};
  Partition[
    Table[
     {pic, {pts[mr]}} = 
      Reap[ContourPlot[y^2 (10 - x) == x^3, {x, 0, .1}, {y, -.1, .1}, 
        PlotPoints -> pp, MaxRecursion -> mr, 
        EvaluationMonitor :> Sow[{x, y}], PlotLabel -> mr, 
        PlotRange -> {{-0.002, maxX}, {-0.015, 0.015}}, 
        ImageSize -> 150, BaseStyle -> Tiny]];
     Show[{Graphics[{LightBrown, 
         Line[Table[{{x0, -0.1}, {x0, 0.1}}, {x0, 0., 0.1, 0.1/(pp - 1)}]], 
         Line[Table[{{0., y0}, {0.1, y0}}, {y0, -0.1, 0.1, 0.2/(pp - 1)}]],
         PointSize[Tiny], LightGray, Point[pts[mr - dmr]],
         Red, Point[Complement[pts[mr], pts[mr - dmr]]]}],
       pic, 
       Graphics[{PointSize[Tiny],
         Red, Point[Cases[Complement[pts[mr], pts[mr - dmr]], {_, 0.}]]}]},
       Options[pic]],
     {mr, mr1, mr2, dmr}],
    4, 4, 1, {}] // GraphicsGrid
  ]
share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.