# Interpolating 3D noisy data

I have some noisy 3D data that looks like this:

SeedRandom[0];
data = Join @@ Table[{x, y, Sin[x*y] + RandomReal[NormalDistribution[0, 0.2]]}, {x, 0, 2 Pi, 0.2}, {y, 0, 2 Pi, 0.2}];


I would like to find a smooth interpolation for the data, like the one in this answer (which only works for 2D data): https://mathematica.stackexchange.com/a/162145

How can I do this?

• Also this answer for making random pebbles might be of interest. (And, no, it does not do what OP wants.) Jul 25, 2019 at 10:09
• You might want to use RLink in Mathematica and use the gam function in the mgcv package. gam stands for "generalized additive model". (Note that this is not a "generalized linear model" which Mathematica does support as GeneralizedLinearModelFit.)
– JimB
Jul 25, 2019 at 13:42

The following approach is somewhat simplistic and limited but it might be good enough.

1. We find Quantile Regression fit for each data subset corresponding to a unique x-axis value. We make a x-value dispatch function that gives a z-value for a pair of x-and-y values.

2. We find Quantile Regression fit for each data subset corresponding to a unique y-axis value. We make a y-value dispatch function that gives a z-value for a pair of x-and-y values.

3. We make the function QFunc that averages the values of the distpatch functions.

4. We apply QFunc over the same x-y-grid of the original data.

Import["https://raw.githubusercontent.com/antononcube/MathematicaForPrediction/master/QuantileRegression.m"]

nKnots = 9;

(* 1 *)
qXFuncs =
Association[#[[1, 1]] ->
QuantileRegression[#[[All, {2, 3}]], nKnots, {0.5}][[1]] & /@
GatherBy[data, #[[1]] &]];

(* 2 *)
qYFuncs =
Association[#[[1, 2]] ->
QuantileRegression[#[[All, {1, 3}]], nKnots, {0.5}][[1]] & /@
GatherBy[data, #[[2]] &]];

(* 3 *)
QFunc[x_, y_] := Mean[{qXFuncs[x][y], qYFuncs[y][x]}];

(* 4 *)
dataSmooth =
Join @@ Table[{x, y, QFunc[x, y]}, {x, 0, 2 Pi, 0.2}, {y, 0, 2 Pi, 0.2}];

GraphicsGrid[{{
ListPlot3D[data, PlotRange -> All, PlotLabel -> "Original data"],
ListPlot3D[dataSmooth, PlotRange -> MinMax[data[[All, 3]]], PlotLabel -> "Smoothed data"]}}, ImageSize -> 800]