Name: Anonymous 2012-12-09 22:36
you sick FUCKS
(define test
'((0 0 0 0 0 0 0 0)
(0 0 0 1 1 0 1 0)
(0 0 1 0 1 0 1 0)
(0 0 1 1 1 0 0 0)
(0 1 0 0 1 1 1 0)
(0 1 1 1 0 0 0 0)
(0 0 0 1 1 0 1 0)
(0 0 0 0 0 0 0 0)))
(define (shiftl l)
`(,@(cdr l) ,(car l)))
(define (shiftr l)
`(,(last l) ,@(reverse (cdr (reverse l)))))
(define (combine . xs)
(cond
((foldl (λ (a b) (or a b)) #f (map null? xs)) null)
((foldl (λ (a b) (and a b)) #t (map (λ (x) (not (list? x))) xs)) (apply list xs))
(else (cons (apply combine (map car xs)) (apply combine (map cdr xs))))))
(define (neighbors m)
(let ((top (shiftr m))
(middle m)
(bottom (shiftl m)))
(map (λ (r) (map (λ (l) (foldl (λ (v i) (+ v i)) 0 l)) r)) (combine (map shiftl top) top (map shiftr top) (map shiftl middle) (map shiftr middle) (map shiftl bottom) bottom (map shiftr bottom)))))
(define (conway cell neighbor-count)
(cond
((= neighbor-count 3) 1)
((and (= 1 cell) (= neighbor-count 2) 1))
(else 0)))
(define (tick m)
(map (λ (l) (map (curry apply conway) l)) (combine m (neighbors m))))
(define (show m)
(for-each (λ (l) (begin (for-each (λ (e) (display (if (= e 1) "*" " "))) l) (newline))) m))
(define (life time torus)
(let loop ((gen 0) (t torus))
(unless (= gen time)
(printf "Generation ~s\n" gen)
(show t)
(loop (add1 gen) (tick t)))))