# adding noise (or perturbing) to a surface

Perhaps a stupid question but I am used to that.

This is a perfect smooth surface with circle contour. How can I add some small noise to it to have an actual moutain look with not so smooth contours

fa = E^-(x^2 + y^2)^.5;

min = 0;
max = 1;

f1 = Plot3D[fa, {x, -3, 3}, {y, -3, 3}, PlotRange -> {min, max},
ClippingStyle -> None, MeshFunctions -> {#3 &}, Mesh -> 15,
MeshStyle -> Opacity[.5],
RGBColor[0.54938, 0.773313, 0.848103]}, {Opacity[.8],
RGBColor[0.9, 0.9, 0.9]}}, Lighting -> "Neutral",
Boxed -> False, PlotPoints -> 100];
slice = SliceContourPlot3D[fa,
z == min - 3, {x, -3, 3}, {y, -3, 3}, {z, min - 3, min + 1},
PlotRange -> {min, max}, Contours -> 20, Axes -> False,
PlotPoints -> 50, PlotRangePadding -> 0,
ColorFunction -> "LightTerrain"];
Show[f1, slice, PlotRange -> All, BoxRatios -> {1, 1, 1.5},
FaceGrids -> {Back, Left}, AxesLabel -> {"x", "y", "z"},
Ticks -> None, BaseStyle -> {FontFamily -> "Times New Roman"}] • Please post the minimum code necessary for the problem. Do we really need to know all your RGBColor schemes? Or FaceGrids? Or AxesLabels? Or BoxRatios? Of label Font choices? Or ColorFunction? Or...????? Mar 10, 2017 at 21:24
• Wouldn't Plot3D[E^-(x^2 + y^2)^.5, {x, -3, 3}, {y, -3, 3}] include everything you need for your question? Mar 10, 2017 at 21:31
• If you are just interested in adding some random noise you could try something along the lines of Plot3D[E^-Sqrt[x^2 + y^2] RandomReal[{.75, 1.25}], {x, -3, 3}, {y, -3, 3}, PlotRange -> All] Mar 10, 2017 at 23:37
• Not sure what you want to have? You want the conturs (=boundaries) to be NOT smooth? How about a Bessel Function? Plot3D[BesselJ[0, 3*Sqrt[(x^2 + 2*y^2)]], {x, -3, 3}, {y, -3, 3}, PlotRange -> Full] Mar 11, 2017 at 0:00
• The proposed solution of Marchi and Paul Saturday fails to generate mountain like contours Mar 11, 2017 at 6:03

Mandelbrot suggested that the fractal surfaces arising from fractional Brownian motion can be used to model rough surfaces in nature, such as mountains. Luckily, Roman Maeder's The Mathematica Programmer II (1996) has a chapter on fractional Brownian motion which we can use. I wrote new code for this answer, but the idea in the code is the same as in the code Maeder wrote over twenty years ago.

The algorithm is the following:

1. Generate a grid of values in some manner with $n$ sample points in each direction.
2. Interpolate the grid linearly and refine the grid by sampling it with $n/r$ points in each direction.
3. Add a Gaussian random number to each grid point. If a finer grid is desired, go back to (2).

There are two parameters used in this algorithm. The first one is $r$, which is called the lacunarity. For example, if $r = 0.5$ then the number of points is increased by two in each direction every iteration. The other parameter is $h$, the Hurst exponent, which is related to the fractal dimension of the limit surface. The fractal dimension is $3 - h$. Generally, a lower Hurst exponent gives a more noisy surface.

step[r_, h_, {xmin_, xmax_}, {ymin_, ymax_}][{ox_, oy_, interp_}] :=
Module[{delta, nx, ny, t, T},
nx = Ceiling[ox/r];
ny = Ceiling[oy/r];
t = 1./(Max[{nx, ny}] - 1);
T = 1./(Max[{ox, oy}] - 1);
delta = Sqrt[0.5] Sqrt[1 - (t/T)^(2 - 2 h)] t^h;
{
nx,
ny,
Interpolation[Flatten[Outer[
{{#, #2}, interp[#, #2] + delta RandomVariate[NormalDistribution[]]} &,
Subdivide[xmin, xmax, nx],
Subdivide[ymin, ymax, ny]
], 1], InterpolationOrder -> 1]
}
]


Here we create an initial grid with values from the given function and visualize the linear interpolation. There are ten grid points in each direction:

init = Flatten[Outer[
{{#, #2}, E^-(#^2 + #2^2)^.5} &,
Subdivide[-3, 3, 10],
Subdivide[-3, 3, 10]
], 1];
interp = Interpolation[init, InterpolationOrder -> 1];

Plot3D[
interp[x, y], {x, -3, 3}, {y, -3, 3},
PlotRange -> Full,
ColorFunction -> ColorData["GreenBrownTerrain"],
Mesh -> False
] Now we refine the grid four times with $r = 0.5$, i.e. we double the number of grid points in each direction four times. The Hurst exponent is 0.75.

{nx, ny, f} = Nest[step[0.5, 0.75, {-3, 3}, {-3, 3}], {10, 10, interp}, 4];
Plot3D[
f[x, y], {x, -3, 3}, {y, -3, 3},
PlotRange -> Full,
ColorFunction -> ColorData["GreenBrownTerrain"],
Mesh -> False
] As we can see, new rough detail has appeared on the surface. Setting fa = f[x,y] we can see how this looks with the visualization technique in the OP: Other parameter values will result in different looking surfaces, depending on what one wants it might be worth it to try a few different ones.

You could use a 2D Gaussian random field taking code from this question. Here I've used the fields function from my own answer but any of them would work.

For this approach you're plotting a dataset instead of a function so use ListPlot3D.

n = 300;
smooth = Table[E^-(x^2 + y^2)^.5, {x, -3, 3, 6/(n - 1)}, {y, -3, 3, 6/(n - 1)}];
rand = -0.5 + Rescale@First@fields[n, -3.5];

m = smooth + 2 smooth rand;

ListPlot3D[m, Mesh -> None,
ColorFunction -> ColorData[{"SandyTerrain", "Reverse"}],
PlotRange -> {0.05, Max[m]}, Boxed -> False, Axes -> False,
ClippingStyle -> RGBColor[0, 0.4, 0.6], BoundaryStyle -> None,
BoxRatios -> {1, 1, 0.2}] 