5
$\begingroup$

What are the best ways to comparing numerical and exact solutions in 3D plots? For example, suppose that I have have numerical and exact solutions as follows:

uexact[x_, t_] := x*t; unumeric[x_, t_] := 0.0000001 + x*t; Plot3D[{unumeric[x, t], uexact[x, t]}, {x, 0, 2}, {t, 0, 2}]
  • I often come across 3d plots as follows. How can I create a 3D comparison plot like this?

enter image description here

  • What hat are your suggestions as an alternative for the comparison?
Improve this question
$\endgroup$
4
  • 4
    $\begingroup$ I think plotting the difference can give you a more accurate picture about the errors. $\endgroup$ Commented May 29, 2021 at 10:38
  • 2
    $\begingroup$ To reproduce the plot use Show[ Plot3D[ uexact[x, t], {x, 0, 2}, {t, 0, 2}], Graphics3D[{AbsolutePointSize[4], Point[ Flatten[ Table[{x, t, unumeric[x, t]}, {x, 0, 2, 0.125}, {t, 0, 2, 0.125}], 1]]}]] $\endgroup$ Commented May 29, 2021 at 12:38
  • $\begingroup$ It's what I look for. Thank you @BobHanlon. Lastly. how to add the legends? $\endgroup$ Commented May 29, 2021 at 23:16
  • $\begingroup$ Legended[ Show[ Plot3D[ uexact[x, t], {x, 0, 2}, {t, 0, 2}, PlotLegends -> SwatchLegend[ {HoldForm[ uexact[x, t]]}]], Graphics3D[ {AbsolutePointSize[4], Point[ Flatten[ Table[{x, t, unumeric[x, t]}, {x, 0, 2, 0.125}, {t, 0, 2, 0.125}], 1]]}], AxesLabel -> (Style[#, 14, Bold] & /@ {x, t, u})], PointLegend[{Black}, {HoldForm[unumeric[x, t]]}, LegendMarkerSize -> 12]] $\endgroup$ Commented May 30, 2021 at 0:54

1 Answer 1

Reset to default
4
$\begingroup$

If the numeric function approximates the exact solution closely, then the difference will probably be imperceptible in comparing the plots of each. One could use ColorFunction to visualize the error on the plot of either uexact or unumeric. The easiest way to me is a two/three-step process: Plot the function with a fine grid (higher PlotPoints) and a random ColorFunction, use the data from the plot to compute the error on the plot grid, and replace the colors in the plot by a gradient depending on the error.

I saved each computational step, more or less, in a variable, in case you want to inspect the intermediate results.

ClearAll[uexact, unumeric, x, y, t]; uexact[x_, t_] := (1 + (x - 1)^3)*Sin[Pi t + x]; data = Flatten[ Table[{x, t, uexact[x, t]}, {x, 0., 2., 1/2.}, {t, 0., 2., 1/4.}], 1]; unumeric = Interpolation[data]; plot = Plot3D[unumeric[x, t], {x, 0, 2}, {t, 0, 2}, ColorFunction -> Hue, PlotPoints -> 50]; pts = First@Cases[plot, GraphicsComplex[p_, ___] :> p, Infinity]; unum = pts[[All, 3]]; (* values of unumeric[x, t] *) uex = uexact @@@ pts[[All, {1, 2}]]; (* values of exact[x, t] *) du = unum - uex; (* errors (absolute) *) max = Max@Abs[du]; (* for scaling error because... *) scerr = 0.5 + 0.5 du/max; (* color functions' domains are [0, 1] *) plot = Legended[ (* recolor plot according to scerr *) plot /. HoldPattern[VertexColors -> _List] -> VertexColors -> (ColorData["TemperatureMap"] /@ scerr), BarLegend[{"TemperatureMap", {-max, max}}] ]

Since the example I chose is an interpolation, the relationship to the interpolation grid is significant. We can add it to the plot above:

Show[plot, Graphics3D[{PointSize@Medium, Point@data}]]
Improve this answer
$\endgroup$
3
  • $\begingroup$ It's what I look for. Thank you very much. Lastly. how to add the legends? $\endgroup$ Commented May 29, 2021 at 23:17
  • $\begingroup$ @RF_1 I added my legend with Legended[], using the range computed for scaling scerr. It’s in the first code block above. Or did you mean some other legend? $\endgroup$ Commented May 30, 2021 at 0:00
  • $\begingroup$ In fact, I mean that PointLegend and SwatchLegend in order to explain which one is the uexact or unumeric. $\endgroup$ Commented May 30, 2021 at 6:21

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.