# How can I improve ContourPlot to get smooth curve?

I am working on the ContourPlot to creat contour line of a InterpolatingFunction recently. This is my data. This is my simple code:

Get["C:\\Users\\Administrator\\Desktop\\data.mx"]

hx = Derivative[1, 0][mdfun];
hxxx = Derivative[3, 0][mdfun];
scaledA[d_, B_, k_, e_, hx_, h_, hxxx_] := (3*d*(1 + B*k)*hx)/((k + h + B*k*h)^3*e) + 3*1/e*hxxx + 3*1/e*hx;
A = scaledA[-1, 1, 0.1, 0.05, hx[x, 11.35], mdfun[x, 11.35], hxxx[x, 11.35]];
scaledϕ[A_, z_, h_, B_, k_, hx_, e_, m_] := A*(z^3/6 - (h*z^2)/2) -
m ((1 +B*k)*k*hx*z^2)/((k + h + B k h)^2*e);

sl = ContourPlot[scaledϕ[A, y, mdfun[x, 11.35], 1, 0.1, hx[x, 11.35], 0.05, -5],
{x, 0, 2*Sqrt π}, {y, 0, mdfun[x, 11.35]},
RegionFunction -> Function[{x, y, z}, 0 <= y <= mdfun[x, 11.35]],
ImageSize -> 600, Contours -> 20, PlotPoints -> 100,
ContourStyle -> Directive[Black, Thin], Frame -> False]


I got a graph with zigzag curve.

I have tried to increase PlotPoints up to 100, MaxRecursion up to 6 (which has turned off my machine :) ), and PrecisionGoal up to 10 (which is less than the PrecisionGoal(40) of my InterpolatingFunction) that run away rather easy :P, and also PerformanceGoal->"Quality". However, by anyway, I can not get an acceptable plot. Is there any way to improve the quality of ContourPlot? Is there any possible to use filter?

• About how long does it take to generate the contour? Even with PlotPoints -> 100 deleted, I still am waiting for a result. Dec 20 '14 at 17:24
• Hello, @bbgodfrey. Thank you again! In this code, I use Contours -> 20 rather than specifying any value to my function, so it take about 50s in my common PC to generate the contour even PlotPoints -> 100. Please feel free to test it :). Dec 21 '14 at 2:22
• My PC took almost 90 sec just to create the 1D plot below. Is it possible that we have different versions of the data.mx file? Very strange. By the way, feel free to contact me by email, if you wish. Brendan.Godfrey@ieee.org Dec 21 '14 at 3:18
• The data file is fairly large and I'm on a slow connection, so forgive me for asking, but does the file contain the original data array or just the InterpolatingFunction? As bbgodfrey's answer shows, the oscillations are inherent in the InterpolatingFunction, and it's quite possible that adjusting the parameters of Interpolation could solve the problem, but to do that we would need the original data.
– user484
Dec 21 '14 at 3:51
• @bbgodfrey, Thank you Dr. Godfrey :). I will contact you properly! The data should be same. Please try my ContourPlot in the original post, I have checked OP with the data link again, it takes 51.79 seconds to generate the contour line. My machine: i5-3470 CPU@ 3.2 GHz, RAM 4G, MMA9.0. Dec 21 '14 at 4:19

A slice of the function

Plot[scaledϕ[A, .2, mdfun[x, 11.35], 1, 0.1, hx[x, 11.35], 0.05, -5], {x, 0, 3}] suggests that the irregular contours and long running time are due to the fine structure of mdfun. Averaging over the fine structure before generating the ContourPlot may give smoother contours, if details of the fine structure are not needed in the plot.

The small, rapid oscillations apparent in the plot above can be traced to hxxx, the third derivative of mdfun with respect to x. This oscillation can be eliminated, and the computational speed improved as well, by creating 1-D interpolation functions and then applying LowpassFilter to hxxx:

im = 199;
mddta1d = Table[x = i N[2*Sqrt π]/im; {x, N[mdfun[x, 11.35]]}, {i, 0, im}];
mdfunh = Interpolation[mddta1d, InterpolationOrder -> 7, Method -> "Hermite",
PeriodicInterpolation -> True];
hxh = Derivative[mdfunh];
mdfunhhxxx = Derivative[mdfunh];


im and the Interpolation options are chosen to match those in mdfun. Increasing im or the InterpolationOrder actually make things worse, and using "Spline" instead of "Hermite" has little effect on the third derivative, plotted below directly from the interpolation points of mdfunhhxxx.

ListPlot[mdfunhhxxx["ValuesOnGrid"], PlotRange -> All] A blowup of this curve would show oscillation among adjacent points of about 0.013 for the first and last 70 points. The central section is extremely noisy. Smoothing of the two wings of the plot is achieved by

hxxxtab = LowpassFilter[mdfunhhxxx["ValuesOnGrid"], 2];
hxxxtab[] = 0; hxxxtab[] = 0; hxxxtab[[im + 1]] = 0;
hxxxtab1d = Table[x = i N[2*Sqrt π]/im; {x, hxxxtab[[i + 1]]}, {i, 0, im}];
hxxxh = Interpolation[hxxxtab1d, InterpolationOrder -> 7, Method -> "Hermite",
PeriodicInterpolation -> True];


Note that this process changes somewhat the values of the third derivative for the central 6o or so points but does not convert them into a smooth curve. Inserting mdfunh, hxh, and hxxxh into the equations given in the Question (and setting Contours -> 40) yields the desired result. One should, of course, be cautious in interpreting the central portion of the curve, in light of the very noisy hxxx values there.

• @ bbgodfrdey, Just as you illustrated, I agree with you. But problem is how can we smooth the fine structure before using ContourPolt. Dec 21 '14 at 2:32
• I presume that you wish to keep the overall shape but eliminate the fast oscillations shown in the plot above. If so, I believe that I can find a way today. Please confirm. Dec 21 '14 at 3:10
• @ bbgodfrey, it looks like a nice trick! I think I need some time to understand your method. Thank you very much! Dec 24 '14 at 6:18