Elementary Cellular Automata in Scheme

eca.scm

(define (d2b n x)
  (let loop ((d n) (r '()))
    (if (= d 0) (let ((b (if (null? r) '(0) r)))
                  (append (make-list (- x (length b)) 0) b))
        (loop (quotient d 2) (cons (modulo d 2) r)))))

(define (cinit cnum)
  (let ((ci (make-list (+ (quotient cnum 2) (modulo cnum 2)) 0)))
    (append ci '(1) (make-list (- (quotient cnum 2) 1) 0))))

(define (getr x y z g) (list-ref g (+ (* x 4) (* y 2) z)))

(define (cnext c g)
  (let loop ((c c) (cn `(,(getr 0 (car c) (cadr c) g))))
    (if (null? (cddr c)) (reverse (cons (getr (car c) (cadr c) 0 g) cn))
        (loop (cdr c) (cons (getr (car c) (cadr c) (caddr c) g) cn)))))

(define (cprint c)
  (for-each (lambda (x) (display (if (= x 1) "*" " "))) c) (newline))

(define (eca r cnum step)
  (let ((g (reverse (d2b r 8))) (ci (cinit cnum)))
    (cprint ci)
    (let loop ((s step) (cn (cnext ci g)))
      (cprint cn)
      (if (not (= s 0)) (loop (- s 1) (cnext cn g))))))

(eca (read) 180 80)