12
$\begingroup$

I would like to smooth out the jagged edges in the outermost contours in the following plot:

Plot with jagged edges.

I have data of values as a function of variables (x,y) in the form

data = {{{x1,y1},z1},{{x2,y2},z2},...};

The figure is produced by

data = << "data.dat";
fnct = Interpolation[data];    
RegionPlot[{fnct[x, y] > 2, fnct[x, y] > 100, fnct[x, y] > 140}, {x, 10^-2, 10^1}, {y, 0, 3},MaxRecursion->5]

The outer edges seem jagged I guess because the data is not very good there. I need to fit a smooth contour instead. I've looked at some other questions like Smoothing ListContourPlot contours but that uses ListContourPlot which for me takes ages and produces a bad result even for the original figure.

Any help appreciated.

The data can be found here:

https://dl.dropboxusercontent.com/u/34796693/data.dat

Improve this question
$\endgroup$
2
  • 1
    $\begingroup$ The moving average method will damage the data a lot, so I recommend to use Gaussian Filter to do the smoothing, which will primarily get rid of the noises without changing the figure too much. $\endgroup$ – Yuncong Ma Mar 1 '16 at 23:46
  • $\begingroup$ I recommend presenting the computation and its result. $\endgroup$ – bbgodfrey Mar 2 '16 at 0:44
9
$\begingroup$

First we import the data, which OP is kind enough to leave in his Dropbox for these past 18 months.

data = N@Get["https://dl.dropboxusercontent.com/u/34796693/data.dat"];

Next we look at the data and notice that it is on a rectangular grid,

Dimensions[data]
Dimensions@Gather[data[[All, 1, 1]]]
(* {180901, 2} *)
(* {601, 301} *)

This is going to make all the difference here (if it weren't on a rectangular grid than you wouldn't have been able to do a decent Interpolation anyway).

The plan here is to apply a MovingAverage along the rows and columns of the grid. MovingAverage likes to work on matrices or vectors, not lists like {{{x1,y1},z1},{{x2,y2},z2}....}, so there are a couple of reshaping steps thrown in here for good measure.

npts = 10;
smootheddata = {{#1, #2}, #3} & @@@
   Flatten[
    Transpose[
     MovingAverage[#, npts] & /@
      Transpose[
       MovingAverage[#, npts] & /@
        Partition[Flatten /@ data, 301]
       ]
     ]
    , 1];

Now you just do as you were doing before, create an interpolation function then apply RegionPlot to it, but now you must be aware that you have a smaller range of gridpoints after applying the averaging. 

{{xmin, xmax}, {ymin, ymax}} = 
 MinMax /@ Transpose[smootheddata[[All, 1]]]
fnct = Interpolation[smootheddata];
RegionPlot[{fnct[x, y] > 2, fnct[x, y] > 100, fnct[x, y] > 140}, {x, 
  xmin, xmax}, {y, ymin, ymax}, MaxRecursion -> 5]

(* {{0.0107256, 9.66286}, {0.045, 2.955}} *)

enter image description here

You can see that it is probably fine to just average the rows, but the best results come from averaging both rows and columns.

enter image description here

Above I've used 10 as the number of elements to average over, but you can get a smoother plot by including more elements. This will have the effect of decreasing the size of the grid points so you have to choose the best option. Here are a few values for npts

enter image description here

Improve this answer
$\endgroup$
1
  • $\begingroup$ Thank you for an informative (if somewhat belated) solution. $\endgroup$ – Philo Jan 14 '16 at 16:30

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.