This entry is based on an idea by Paul Bourke for generating simulated landscapes through the application of the two-dimensional discrete Fourier transform to an array of uniformly-distributed random numbers. I was also inspired by some of the color gradients featured in GRASS, and decided to see if I could make a somewhat realistic color gradient for depicting a simulated landscape. Here is the color gradient that resulted from my many experiments:

`topoFake[u_?NumericQ] :=`

Blend[{{0, RGBColor[0, 1/10, 1/4]}, {1/5, RGBColor[0, 3/5, 3/5]}, {1/5, RGBColor[206/255, 197/255, 12/17]}, {1/4, RGBColor[39/85, 9/26, 5/44]}, {11/40, RGBColor[14/25, 27/40, 2/9]}, {23/80, RGBColor[9/14, 19/25, 12/85]}, {1/3, RGBColor[7/15, 29/42, 1/255]}, {3/8, RGBColor[3/10, 3/5, 5/98]}, {17/40, RGBColor[0, 38/85, 0]}, {19/40, RGBColor[0, 6/17, 0]}, {21/40, RGBColor[0, 3/10, 0]}, {23/40, RGBColor[0, 1/4, 0]}, {5/8, RGBColor[0, 1/8, 0]}, {5/8, RGBColor[39/85, 9/26, 5/44]}, {43/60, RGBColor[3/5, 25/54, 1/6]}, {97/120, RGBColor[19/23, 7/10, 1/3]}, {151/180, RGBColor[7/8, 3/4, 13/36]}, {313/360, RGBColor[39/44, 15/17, 2/5]}, {9/10, RGBColor[13/17, 9/11, 16/51]}, {9/10, RGBColor[1/2, 1/2, 1/2]}, {91/100, RGBColor[1/2, 1/2, 1/2]}, {91/100, RGBColor[1, 50/51, 50/51]}, {19/20, RGBColor[1, 50/51, 50/51]}, {19/20, RGBColor[3/4, 3/4, 3/4]}, {24/25, RGBColor[3/4, 3/4, 3/4]}, {24/25, RGBColor[1, 50/51, 50/51]}, {1, RGBColor[1, 50/51, 50/51]}}, u] /; 0

I wanted to try it out on a simpler function first, and decided to use the `peaks()`

function of MATLAB as a test case:

`Plot3D[3 (1 - x)^2 E^(-x^2 - (y + 1)^2) - 10 (x/5 - x^3 - y^5) E^(-x^2 - y^2) - 1/3 E^(-(x + 1)^2 - y^2), {x, -3, 3}, {y, -3, 3},`

Axes -> None, BoundaryStyle -> None, Boxed -> False,

ColorFunction -> (topoFake[#3] &), Mesh -> False,

PerformanceGoal -> "Quality", PlotPoints -> 85, PlotRange -> All,

ViewPoint -> {-1.3, -2.4, 2.}]

Not too shabby, eh? Here’s what results if we try out the gradient on a modification of Bourke’s idea:

`With[{n = 256},`

BlockRandom[SeedRandom[20, Method -> "Legacy"];

ListPlot3D[Abs[InverseFourier[

Fourier[RandomReal[{0, 1}, {n, n}]] * Table[

Sech[(i/n - 0.5)/0.025] * Sech[(j/n - 0.5)/0.025],

{i, n}, {j, n}]]],

Axes -> None, Boxed -> False, BoundaryStyle -> None,

BoxRatios -> {1, 1, 1/10}, ColorFunction -> (topoFake[#3] &),

Mesh -> False, PerformanceGoal -> "Quality"]]]

The resulting archipelago looks a tad chaotic, but it’s a start. I’m still looking for a way to modify Bourke’s technique to produce bigger “islands”.