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}} *)

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

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
