## Bunnies, teapots, and noise

March 16, 2012

I should be able to have regular Internet access soon. For now, I’d like to share some of the experiments I did with coloring 3D objects with the help of Ken Perlin’s simplex noise in Mathematica. (Relatedly, I’ve found that the implementation of improved Perlin noise supplied in the Mathematica help file has a few subtle flaws, which I was able to fix. That would be for another blog entry, though.)

Here are some of the results of coloring the Utah teapot with simplex noise:

Here are some results of coloring the Stanford bunny with simplex noise:

I never would have thought that Mathematica would ever be able to do graphics as fancy as this. I’ll only note that none of these used the `Texture[]` construct; both models in fact used simplex noise as solid textures (i.e. an `RGBColor[]` associated with each point in the model).

I might write a (series of) more descriptive post(s) on these things much later; for now, these pictures, entirely generated in Mathematica (no post-processing at all!) will have to suffice.

## On making simulated landscapes

March 1, 2012

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”.