automaton.scm

automata.scm

;;;; automatom.scm

;; rules are binary trees of booleans

;; colors: black = #t and left
;;         white = #f and right

;; layers: left  =  0
;;         top   =  1
;;         right =  2

;; so rule 30 = 00011110 is
;;               .
;;         /           \
;;       /   \       /   \
;;     / \   / \   / \   / \
;;    #f #f #f #t #t #t #t #f

(define (number->boolean r)
  (= r 1))

(define (boolean->getter b)
  (if b car cdr))

(define (make-rule r)
  (let iter ((n 8) (r r))
    (if (= (modulo n 2) 0)
        (let ((qr (integer-divide r (expt 2 (/ n 2)))))
          (let ((remainder (integer-divide-remainder qr))
                (quotient (integer-divide-quotient qr)))
            (cons (iter (/ n 2) quotient)
                  (iter (/ n 2) remainder))))
    (number->boolean r))))

(define (state-folder rule state)
  ((boolean->getter state) rule))

(define (apply-rule rule state)
  (fold-left state-folder rule state))

;; layers are vectors of booleans
(define first-layer (vector #t))

(define (layer-ref layer j)
  (if (and (>= j 0) (< j (vector-length layer)))
      (vector-ref layer j)
      #f))

(define ((make-layer-ref layer) j) 
  (layer-ref layer j))

(define (generate-next-layer rule previous-layer)
  (make-initialized-vector 
   (+ 2 (vector-length previous-layer))
   (lambda (i)
     (apply-rule rule (map (make-layer-ref previous-layer) (iota 3 (- i 2)))))))

(define rule (make-rule-tree 30))

(generate-next-layer rule first-layer)

(generate-next-layer rule (generate-next-layer rule first-layer))

(define (generate-layers rule n)
  (let iter ((layers (list first-layer)) (n n))
    (if (> n 1)
        (iter (cons (generate-next-layer rule (car layers)) layers) (- n 1))
        layers)))