How to visualize 3D fit

Question

I have a data set of x,y,z values and I fit a function of x,y to the data. This works, but I can't come up with a nice way to visualize the data. 3D plots are not very clear on paper and a contour plot of two data sets doesn't work either. What would be a clear and simple way to show the data and the fit?

data = Import["https://pastebin.com/raw/mTUJAZrM"];
fit = NonlinearModelFit[
       data, 
       A*Exp[-(y - y0 - y1 Cos[2 (x/180*Pi)])^2/(w0 + w1 Cos[2 x/180*Pi])^2],
       {A, {y0, 0.04}, {y1, 0.00}, {w0, 0.03}, {w1, 0.01}},
       {x, y}
      ];
Show[
     ListPointPlot3D[data],
     Plot3D[fit["BestFit"], {x, 0, 180}, {y, 0, 0.1}]
    ]

EDIT:

What I decided to do for now is using a DensityPlot of the data with the ContourPlot of the fit (similar to Rahul Narain's answer). This does not really show the quality of the model, so I will add other plots, candidates are

• residuals vs. predicted values (similar to chris's answer)
• distribution of residuals (chris's answer)
• Q-Q plot using QuantilePlot[fit["FitResiduals"]]
• the plot Rahul Narain suggested

Answer 1

If what you want to visualize is how good the fit is, then you should do as @whuber suggests and plot the residuals, that is, the difference between the data and the fitted function. Below, each data point is drawn as a point with area proportional to the magnitude of the residual. Red means that the data value is higher than the fit; blue means the data is lower. For context, the contours of the fit are plotted in the background.

residual[{x_, y_, z_}] := Evaluate[z - fit["BestFit"]]
rmax = Max[(Abs@residual@#) & /@ data];
residualPoint[p : {px_, py_, pz_}] := Module[{r},
  r = residual[p]/rmax;
  {AbsolutePointSize[10 Sqrt@Abs@r], 
   ColorData["ThermometerColors"][(r + 1)/2], Point[{px, py}]}]
Show[ContourPlot[fit["BestFit"], {x, 0, 180}, {y, 0, 0.1}, 
  AspectRatio -> 1, ContourShading -> None], 
 Graphics[Flatten[residualPoint /@ data]]]

There does seem to be a little bit of systematic bias in the residuals. If I had to guess, I'd say the fitted function tends to overestimate the data at the left and right ends of the "ridge", and underestimates the data at the lower corners. And perhaps the ridge ought to form a narrower "V". However, I am not a statistician.

Anyway, if you want to both visualize the shape of the fit and also indicate how far it is from the data simultaneously, you could lay these residual markers right on top of your 3D plot.

residualPoint3D[p : {x_, y_, z_}] := 
 Evaluate@Module[{r}, r = residual[p]/rmax;
   {AbsolutePointSize[2 + 8 Sqrt@Abs@r], 
    ColorData["ThermometerColors"][(r + 1)/2], 
    Point[{x, y, fit["BestFit"] + 1*^-5}]}]
Show[Plot3D[Evaluate@fit["BestFit"], {x, 0, 180}, {y, 0, 0.1}, 
  Mesh -> 5, MeshFunctions -> {#3 &}, MeshStyle -> Gray, 
  Lighting -> {{"Ambient", White}}], 
 Graphics3D[Flatten[residualPoint3D /@ data]]]

Answer 2

I would try

  plt=Show[ListPointPlot3D[data, ColorFunction -> "Rainbow"], 
  Plot3D[fit["BestFit"], {x, 0, 180}, {y, 0, 0.1}, 
  PlotStyle -> 
  Directive[Yellow, Specularity[White, 20], Opacity[0.3]]], 
  BoxRatios -> {1, 1, 1}]

Then you can change perspective?

  GraphicsArray[{{plt, 
  Show[plt, ViewPoint -> Front]}, {Show[plt, ViewPoint -> Top], 
  Show[plt, ViewPoint -> {1, 1, 1}]}}, ImageSize -> 600]

EDIT

Following @whube's suggestion and using @ArgentoSapiens's code we see that the residual have a reasonable distribution:

 (Last /@ actualpredicted[[1]]) - (Last /@ actualpredicted[[2]]) // Histogram

With a relative error of 25 %

 StandardDeviation[(Last /@ actualpredicted[[1]]) - (Last /@ 
 actualpredicted[[2]])]/Mean[(Last /@ actualpredicted[[1]])]


  (* 0.24 *)

If we look at the distribution of residual versus the actual value:

  {(Last /@ 
   actualpredicted[[1]]), (Last /@ actualpredicted[[1]]) - (Last /@ 
   actualpredicted[[2]])} // Transpose // ListPlot

We do find a bias for higher values.

And since I am stealing shamelessly from the other answers, a mixture of them all yields

  plt2 = With[{actualpredicted = {data, 
  Transpose[
  Append[Transpose[fit["Data"][[All, {1, 2}]]], 
   fit["PredictedResponse"]]]}}, 
  Show[ListPointPlot3D[actualpredicted, ColorFunction -> "Rainbow"], 
  plt, Graphics3D[{Opacity[0.25], 
  Line /@ Transpose[actualpredicted]}], BoxRatios -> {1, 1, 1}]]

  GraphicsGrid[{{plt2, 
  Show[plt2, ViewPoint -> Front]}, {Show[plt2, ViewPoint -> Top], 
  Show[plt2, ViewPoint -> {1, 1, 1}]}}, ImageSize -> 600] 

Answer 3

I like to draw the predicted and actual responses and connect them with a little line. That shows where the fit is good and where it isn't.

With[{ actualpredicted={ data, Transpose[ Append[ Transpose[ fit["Data"][[All,{1,2}]]],
                                                  fit["PredictedResponse"] ] ] } },
     Show[ ListPointPlot3D[actualpredicted, PlotStyle -> {Red, Gray}],
           Graphics3D[{Opacity[0.25], Line /@ Transpose[actualpredicted]}]
         ]
    ]

Answer 4

Edit: actually this is very redundant with chris' answer. I keep it for the moment though.

I like to style the data points according to offset from the fit:

Show[{
 Plot3D[fit[x, y], {x, 0, 175}, {y, 0., 0.1},     
        ColorFunction -> "DarkRainbow", 
        PlotStyle -> None, 
        Mesh -> 10],   
 ListPointPlot3D[Partition[data, 1], 
                 Ticks -> Automatic, 
                 Axes -> True,  
                 FillingStyle -> Thin,     
                 Filling ->Thread[Range[1, Length[data]] -> 
                      Table[fit[Sequence @@ data[[i, {1, 2}]]], 
                            {i, 1, Length[data]}]],
                 ColorFunction -> Function[{x, y, z}, 
                 Blend[{{-.0004, Darker@Red}, {-.0002, Red}, {0, Green}, {.0002, 
                 Blue}, {.0004, Lighter@Blue}}, z - fit[x, y]]],
                 ColorFunctionScaling -> False, 
                 BoxRatios -> Automatic,     
                 FillingStyle -> Directive[LightGreen, Thick]]
      }]