scheme
lisp
common
r6rs
bowler
ocaml
pgm
naked
ccc
untyped
london
err5rs
arc
art
haskell
random
r5rs
-
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))