7
$\begingroup$

I have a large list at list3, when I use of ListPlot3D list, I face to some undesired points which are sharp and caused by calculation error. I want to replace them with the best value in order to have a smooth plot without any sharps points. If my data was short I could correct them manually but the list is very large and I am not able correct them by hand. Is there any way to correct automatically them. I have seen LinearModelFit or Most in some posts but they don't work correctly.

Just for showing the main question I am bringing the plot below. But my plot must be created after some processes recommended by Jason B (with so much thanks to him) at process for plotting

enter image description here

$\endgroup$
2
  • $\begingroup$ I have to leave for the day, but you might have some luck tracking down the outliers by looking at ListPlot[Differences@list3[[All, 3]], PlotRange -> All] $\endgroup$
    – Jason B.
    Feb 17, 2016 at 16:37
  • 2
    $\begingroup$ A quick hack, but not really a solution, rather a starting point: MedianFilter[list3, {1, 0}]. $\endgroup$
    – kirma
    Feb 17, 2016 at 16:58

1 Answer 1

9
$\begingroup$

for single point anomalies MedianFilter (per comment from @kirma) with a little tweaking does a nice job, (This assumes your data is on a regular grid)

data = Table[
   Sin[x] Sin[2 y] + 10 Boole[RandomReal[1] < .001], {x, -Pi, 
    Pi, .1}, {y, -Pi, Pi, .1}];
ListPlot3D[data]

enter image description here

first smooth the data:

smoothed = MedianFilter[data, 1];

then use the smoothed data as a filter, plot original points, except where the MedianFilter made a big change consider that an outlier and plot the median filtered value:

ListPlot3D[
 MapThread[If[Abs[#1 - #2] < 5, #1, #2] &, {data, smoothed} , 2]]

enter image description here

Edit: example using a flattened {{xi,yi,zi},..} data structure:

n = 60; m = 50
data = Flatten[
   Table[{x, y, Sin[x] Sin[2 y] + 10 Boole[RandomReal[1] < .001]},
    {x, -Pi, Pi, 2 Pi/(n - 1)},
    {y, -Pi, Pi, 2 Pi/(m - 1)}], 1];

verify input data is on a rectangular grid, and get width:

Flatten[grid = Table[{x, y},
    {x, SortBy[Union@data[[All, 1]], N]},
    {y, SortBy[Union@data[[All, 2]], N]}], 1] ==
 data[[All, {1, 2}]]
n = Dimensions[grid][[2]]

True

50

smoothed = Flatten@MedianFilter[Partition[data[[All, 3]], n], 1];
ListPlot3D[MapThread[If[Abs[#1[[3]] - #2] < 5, #1,
    Append[#1[[;; 2]], #2]] &, {data, smoothed}]]
$\endgroup$
8
  • $\begingroup$ Smooth data of my real list is too abnormal. I can plot smooth of your table but for my list it is completely destroyed. $\endgroup$ Feb 17, 2016 at 18:42
  • $\begingroup$ @george2079 - do you mind if I edit this answer to show Ackaran exactly how to apply this to his data? It works great, much better than the manual method I was trying. $\endgroup$
    – Jason B.
    Feb 18, 2016 at 8:11
  • $\begingroup$ @Jason B, I had used of smoothed = MedianFilter[list3, 1]; but this function destroyed my data in a amazing shape!!!1 $\endgroup$ Feb 18, 2016 at 8:33
  • 1
    $\begingroup$ @Ackaran, it can be written like list3smooth = With[{list3b = Partition[Last /@ list3, 111]}, Transpose[{list3[[All, 1]], list3[[All, 2]], Flatten@MapThread[ If[Abs[#1 - #2] < .01, #1, #2] &, {list3b, MedianFilter[list3b, 1]}, 2]} ]]; $\endgroup$
    – Jason B.
    Feb 18, 2016 at 13:07
  • 1
    $\begingroup$ Or, in prettier formatting, here: pastebin.com/raw/Mq1WwM8g $\endgroup$
    – Jason B.
    Feb 18, 2016 at 13:09

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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