# Smoothing the Sharp Undesired Points in ListPlot3D

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

• 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] Feb 17, 2016 at 16:37
• A quick hack, but not really a solution, rather a starting point: MedianFilter[list3, {1, 0}]. Feb 17, 2016 at 16:58

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]


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


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

• Smooth data of my real list is too abnormal. I can plot smooth of your table but for my list it is completely destroyed. Feb 17, 2016 at 18:42
• @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. Feb 18, 2016 at 8:11
• @Jason B, I had used of smoothed = MedianFilter[list3, 1]; but this function destroyed my data in a amazing shape!!!1 Feb 18, 2016 at 8:33
• @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]} ]]; Feb 18, 2016 at 13:07
• Or, in prettier formatting, here: pastebin.com/raw/Mq1WwM8g Feb 18, 2016 at 13:09