6
$\begingroup$

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[2] π}, {y, 0, mdfun[x, 11.35]}, RegionFunction -> Function[{x, y, z}, 0 <= y <= mdfun[x, 11.35]], ImageSize -> 600, Contours -> 20, PlotPoints -> 100, ContourShading -> None, 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?

Improve this question
$\endgroup$
9
  • $\begingroup$ About how long does it take to generate the contour? Even with PlotPoints -> 100 deleted, I still am waiting for a result. $\endgroup$ Commented Dec 20, 2014 at 17:24
  • $\begingroup$ 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 :). $\endgroup$ Commented Dec 21, 2014 at 2:22
  • $\begingroup$ 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. [email protected] $\endgroup$ Commented Dec 21, 2014 at 3:18
  • $\begingroup$ 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. $\endgroup$ Commented Dec 21, 2014 at 3:51
  • $\begingroup$ @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. $\endgroup$ Commented Dec 21, 2014 at 4:19

1 Answer 1

Reset to default
7
$\begingroup$

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

Slice through contour plot

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.

Addendum: Smoothed Contours

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[2] π]/im; {x, N[mdfun[x, 11.35]]}, {i, 0, im}]; mdfunh = Interpolation[mddta1d, InterpolationOrder -> 7, Method -> "Hermite", PeriodicInterpolation -> True]; hxh = Derivative[1][mdfunh]; mdfunhhxxx = Derivative[3][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]

Third derivative interpolation plot

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[[1]] = 0; hxxxtab[[2]] = 0; hxxxtab[[im + 1]] = 0; hxxxtab1d = Table[x = i N[2*Sqrt[2] π]/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.

Smoothed contour plot

One should, of course, be cautious in interpreting the central portion of the curve, in light of the very noisy hxxx values there.

Improve this answer
$\endgroup$
3
  • $\begingroup$ @ bbgodfrdey, Just as you illustrated, I agree with you. But problem is how can we smooth the fine structure before using ContourPolt. $\endgroup$ Commented Dec 21, 2014 at 2:32
  • $\begingroup$ 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. $\endgroup$ Commented Dec 21, 2014 at 3:10
  • $\begingroup$ @ bbgodfrey, it looks like a nice trick! I think I need some time to understand your method. Thank you very much! $\endgroup$ Commented Dec 24, 2014 at 6:18

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.