1
$\begingroup$

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?

$\endgroup$
  • $\begingroup$ Also this answer for making random pebbles might be of interest. (And, no, it does not do what OP wants.) $\endgroup$ – Anton Antonov Jul 25 at 10:09
  • $\begingroup$ 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.) $\endgroup$ – JimB Jul 25 at 13:42
1
$\begingroup$

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]

enter image description here

$\endgroup$

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.