• Random art

    Fri, 13 Mar 2009 06:18:16 +0000

    Reading scheme.dk/planet (to which I should resubscribe with this URL), I found a post dealing with (pseudo-)random art. I decided to give it a try, and fired up Common Lisp (I haven't been in a Scheme mood lately.)


    you can see small samples I generated by clicking on those marvellous links: ouou2.png, ouou5.png, ouou6.png, out_0.png, out_2.png.


    Code follows. ;; This code is provided as is.
    ;; It's not particularly efficient nor beautiful.
    ;; It ran well with SBCL
    ;; If you use it, the licence would be BSD
    ;; (ie "do what you want, but cite me")
    ;; contact (in rot13) is cza@onxnevxn.arg

    ;;; Generate pseudo random nice pictures

    ;; Because we want different values each time we run the program,
    ;; don't we?
    (setf *random-state* (make-random-state t))

    ;; Generate an s-expression with
    ;; min-depth m-m
    ;; max-depth d-m
    ;; variables vl
    ;; operators and arity opl
    (defun gen-expr0 (m-m d-m vl opl)
      (let ((var-or-op (random (length opl))))
        (list var-or-op)
        (if (and (< m-m 0) (or (zerop d-m) (zerop var-or-op)))
            (elt vl (random (length vl)))
            (let ((op (elt opl (random (length opl)))))
              (cons (first op)
                    (loop for i below (second op)
                       collect (gen-expr0 (1- m-m) (1- d-m) vl opl)))))))

    ;; Make a "random" function.
    (defun gen-expr (m-m d-m vl opl)
      `(lambda (x y)
         ,(gen-expr0 m-m d-m vl opl)))

    ;; calculate the mean of all parameters
    (defun mean (&rest l)
      (declare (optimize (speed 3)))
      (loop for x in l
         count x into n
         sum x into xs
         finally (return (/ xs n))))

    ;; trigonometric variations
    (defun sinp (x)
      (declare (optimize (speed 3)))
      (sin (* pi x)))
    (defun cosp (x)
      (declare (optimize (speed 3)))
      (cos (* pi x)))

    ;; Euclidian distance to (0,0)
    (defun w-dist (x y)
      (declare (optimize (speed 3)))
      (sqrt (/ (+ (expt x 2) (expt y 2)) 2)))

    ;; map [-1,1[ to [0,255]
    (defun normalize (x)
      (declare (optimize (speed 3)))
      (the fixnum (round (+ 127.5 (* 127.5  x)))))

    ;; prints three values
    (defmacro pixel (r g b)
      `(format fi "~A ~A ~A~%"
               (normalize (funcall ,r x y))
               (normalize (funcall ,g x y))
               (normalize (funcall ,b x y))))

    ;; creates the code for 20 "random" pictures
    (defmacro run0 ()
      (reduce #'(lambda (e r)
                  `(progn ,e ,r))
              (loop for n below 20
                 collect
                 `(with-open-file
                      (fi ,(concatenate 'string "/tmp/out_"
                                        (format nil "~A" n) ".pgm")
                          :if-exists :supersede
                          :if-does-not-exist :create
                          :direction :output)
                    (format fi "P3~%1400 1050~%255~%") ; pgm header
                    (let (            ; make the three component functions
                          (r (gen-expr 6 10 '(x y)
                                       '((mean 2) (mean 3) (* 3)
                                         (abs 1) (w-dist 2) (* 2)
                                         (sinp 1) (cosp 1))))
                          (g (gen-expr 6 10 '(x y)
                                       '((mean 2) (mean 3) (* 3)
                                         (abs 1) (w-dist 2) (* 2)
                                         (sinp 1) (cosp 1))))
                          (b (gen-expr 6 10 '(x y)
                                       '((mean 2) (mean 3) (* 3)
                                         (abs 1) (w-dist 2) (* 2)
                                         (sinp 1) (cosp 1)))))
                      (let (                ; and turn them into closures
                            (vr (eval r))
                            (vg (eval g))
                            (vb (eval b)))
                        ;; dump the formulas as comments
                        (format fi "# R(x y) = ")
                        (write r :stream fi :pretty nil)
                        (terpri fi)
                        (format fi "# G(x y) = ")
                        (write g :stream fi :pretty nil)
                        (terpri fi)
                        (format fi "# B(x y) = ")
                        (write b :stream fi :pretty nil)
                        (terpri fi)
                        ;; compute
                        (loop for y upfrom -1 below 1 by (/ 2 1050)
                           and cpt upfrom 0
                           do
                           (when (zerop (mod cpt 10)) ; debug notice
                             (format t "~A : ~A~%" ,n cpt))
                           (loop for x upfrom -1 below 1 by (/ 2 1400)
                              do
                              (pixel vr vg vb)) ; print!
                           (terpri fi))))))))

    ;; call me, wait, and enjoy!
    (defun run ()
      (run0))