[Haskell-cafe] Re: Zippers, Random Numbers & Terrain

[apfelmus]

Thomas Conway wrote:
> This got me thinking that it would be cool to make an infinite terrain
> generator using a zipper, so you can zoom in/out infinitely, and by
> implication, infinitely in any direction.

After some pondering, I think it's indeed possible and the zipper is the
right tool for the job. I'll present the idea for constructing a
one-dimensional "fractal terrain" but it generalizes to higher dimensions.

First, consider the task to construct a 1D fractal height function
defined on a bounded interval like [0,1].

  type Pos      = Double
  type Height   = Double

  terrain :: Interval -> Pos -> Height

We construct the terrain by dividing the interval in half and adjust the
height of the midpoint randomly relative to the mean of the other heights.

  data Interval = I (Pos,Pos) (Height,Height) StdGen

  terrain :: Interval -> Pos -> Height
  terrain i x
    | x `in` left  = terrain left  x
    | x `in` right = terrain right x
    where
    (left, right)  = bisect i

  in :: Pos -> Interval -> Bool
  in x (I (a,b) _ _) = a <= x && x <= b

  bisect :: Interval -> (Interval, Interval)
  bisect (I (a,b) (ha,hb) g) =
    (I (a,m) (ha,h) ga, I (m,b) (h,hb) gb)
    where
    m = (a+b)/2
    h = (ha+hb)/2 + d * (a-b) * scale
    (d,g')  = randomR (0,1) g
    (ga,gb) = split g'

The factor  scale  controls the roughness of the terrain. True enough,
the function  terrain  never returns but that shouldn't be an issue to
the mathematician ;) Of course, we have to stop as soon as the interval
length is smaller than some given resolution  epsilon  (i.e. the width
of a pixel). Splitting the random number generator is not necessarily a
good idea, but I don't care right now.


For zoom-in, we want to specify different epsilons and get the same
random values each time. So, we memoize the steps to produce the height
function in an infinite tree

  data Terrain = Branch Terrain (Height,Height) Terrain

  terrain :: Interval -> Terrain
  terrain i = Branch (terrain left) h (terrain right)
    where
    (left, right) = bisect i
    I _ h _ = i

The actual rendering can be obtained from the infinite Terrain, I'll
omit it for simplicity.


For finite zoom-out, we use a zipper

  type Zipper  = (Context, Terrain)
  type Context = [Either Terrain Terrain]

  zoomInLeft, zoomInRight :: Zipper -> Zipper
  zoomInLeft  (xs, Branch l h r) = (Left  r:xs, l)
  zoomInRight (xs, Branch l h r) = (Right l:xs, r)

  zoomOut :: Zipper -> Zipper
  zoomOut (x:xs, t) = case x of
      Left  r -> (xs, Branch t (t `joinHeights` r) r)
      Right l -> (xs, Branch l (l `joinHeights` t) t)
    where
    joinHeights (Branch _ (ha,_) _)
                (Branch _ (_,hb) _) = (ha,hb)
  zoomOut ([], _) = error "You fell out of the picture!"

Mnemonics: Left means that we descended into the left half, Right that
we descended into the right half of the interval.


The final step is to allow infinite zoom-out. How to do that? Well,
assume that we generate the landscape on the interval [0,1] and zoom
out. The reverse of this would be to create the landscape on the
interval [-1,1] and then zoom into the right half [0,1]. In other words,
we view [0,1] as the right half of the bigger interval [-1,1]. This in
turn can be viewed as the left half of the even bigger interval [-1,3].
In order to grow both interval bounds to infinity, we alternate between
viewing it as left half and as right half. In other words, the insight
is that *we're inside an infinite context*! Thus, generating an infinite
terrain is like generating a finite one except that we need to generate
the infinite context as well:

  terrainInfinite :: Interval -> Zipper
  terrainInfinite i = (right i, terrain i)
    where

    right (I (m,b) (h,hb) g) = Right (terrain l) : left  i
      where
      l  = fst $ bisect i
      i  = I (a,b) (ha,hb) g'
      a  = m  - (b -m)
      ha = hb - (hb-h) + d * (a-b) * scale
      (d,g') = randomR (0,1) g

    left  (I (a,m) (ha,h) g) = Left  (terrain r) : right i
      where
      r  = snd $ bisect i
      i  = I (a,b) (ha,hb) g'
      b  = m + (m-a )
      hb = h + (h-ha) + d * (a-b) * scale
      (d,g') = randomR (0,1) g

Here,  left  starts by extending a given interval to the right and
right   starts by extending it to the left.

It would be nice to run the random generator backwards, the generator
transitions in  terrainInfinite  are surely wrong, i.e. too
deterministic. Also, the scale of the random height adjustment  d  is
probably wrong. But those things are exercises for the attentive reader ;)


That concludes the infinite terrain generation for one dimension. For
higher dimension, one just needs to use 2D objects instead of intervals
to split into two or more pieces. For instance, one can divide
equilateral triangles into 4 smaller ones. In fact, it doesn't matter
whether the starting triangle is equilateral or not when using the
midpoints of the three sides to split it into four smaller triangles.

Regards,
apfelmus