Fern

Some early Common Lisp code that implements an Iterated Functions System and renders a fern. The parameters for the above image have been lost, but they would have looked something like this:

(create-ifs 512
            512
            *fern-functions*
            :mapping '(-5.0 -2.0 5.0 11.0)
            :iterations 2000000)

Here's the complete IFS system:

(defun fern1 (x y)
  (values 0.0 (* 0.16 y)))

(defun fern2 (x y)
  (values (- (* 0.2 x) (* 0.26 y))
          (+ (* 0.23 x) (* 0.22 y) 1.6)))

(defun fern3 (x y)
  (values (+ (* -0.15 x) (* 0.28 y))
          (+ (* 0.26 x) (* 0.24 y) 0.44)))

(defun fern4 (x y)
  (values (+ (* 0.85 x) (* 0.04 y))
          (+ (* -0.04 x) (* 0.85 y) 1.6)))

(defparameter *fern-functions* (setup-function-weights '((.85 fern4)
                                                         (.07 fern3)
                                                         (.07 fern2)
                                                         (.01 fern1))))

(defun get-fun (funs)
  (weighted-function (/ (random 1000) 1000.0) funs))

(defun next-value (x y funs)
  (funcall (get-fun funs) x y))

(defun ifs-loop (iterations functions fn x y)
  (let ((x1 x)
        (y1 y))
    (dotimes (i iterations)
      (multiple-value-bind (xv yv)
          (next-value x1 y1 functions)
        (progn
          (funcall fn xv yv)
          (setf x1 xv)
          (setf y1 yv))))
    (values x1 y1)))

(defun create-ifs-closure (mapping grid)
  "returns a function which, when given xy co-ordinates will
   map them to a grid and increment the appropriate pixel."
  (let* ((width (array-dimension grid 0))
         (height (array-dimension grid 1))
         (mapping1 (first mapping))
         (mapping2 (second mapping))
         (gw (/ (float (- width 1)) (- (third mapping) mapping1)))
         (gh (/ (float (- height 1)) (- (fourth mapping)  mapping2))))
    #'(lambda (x y)
        (let* ((gx (floor (* (- x mapping1) gw)))
               (gy (floor (* (- y mapping2) gh))))
          (when (and (< gx width) (> gx 0) (< gy height) (> gy 0))
            (incf (aref grid gx gy)))))))

(defun prepare-iterations (warm-up functions mapping)
  (labels ((dummy-function (x y)
             (+ x y))
           (random-within-mapping (min max)
             (let ((range (- max min)))
               (+ min (* range (/ (random 1000) 1000))))))
    (let* ((x1 (random-within-mapping (first mapping)
                                      (third mapping)))
           (y1 (random-within-mapping (second mapping)
                                      (fourth mapping))))
      (when warm-up
        (multiple-value-bind (xp yp)
            (ifs-loop warm-up functions #'dummy-function x1 y1)
          (progn
            (setf x1 xp)
            (setf y1 yp))))
      (values x1 y1))))

(defun create-ifs (width height functions &key
                    warm-up
                    (mapping '(-1.0 -1.0 1.0 1.0))
                    (iterations 100000))
  (let* ((grid (make-array (list width height) :initial-element 0))
         (closure (create-ifs-closure mapping grid)))
    (multiple-value-bind (x y)
        (prepare-iterations warm-up functions mapping)
      (ifs-loop iterations functions closure x y))
    grid))