Conway's Game of Life

game-of-life.rkt

#lang racket

(require 2htdp/image
         2htdp/universe)

; Cell object.
(define make-cell
  (lambda (x y)
    (list (list x y) #f)))

(define is-alive cadr)
(define is-dead (lambda (cell) (not (is-alive cell))))
(define get-cord car)

(define live
  (lambda (c)
    (list (get-cord c) #t)))

(define die
  (lambda (c)
    (list (get-cord c) #f)))

; Board.
(define make-board
  (lambda (rows cols)
    (letrec ([make-row
              (lambda (row r c)
                (if (< c 0)
                    row
                    (make-row (cons 
                               (let ((cell (make-cell r c)))
                                 (if (> (random) 0.5)
                                     (live cell)
                                     cell))
                               row)
                              r
                              (- c 1))))]
             [make-rows
              (lambda (board r)
                (if (< r 0)
                    board
                    (make-rows (cons
                                (make-row '() r (- cols 1))
                                board)
                               (- r 1))))])
      (make-rows '() (- rows 1)))))

(define rows length)

(define cols
  (lambda (board)
    (length (car board))))

(define get-cell
  (lambda (board cord)
    ; Handle bounds.
    (if (or (< (car cord) 0)
            (< (cadr cord) 0)
            (>= (car cord) (rows board))
            (>= (cadr cord) (cols board)))
        '()
    (list-ref (list-ref board (car cord))
              (cadr cord)))))

(define iter-neighbors
  (lambda (board cell cb)
    (letrec ([row (car (get-cord cell))]
             [col (cadr (get-cord cell))]
             [iter
              (lambda (r c)
                (cond
                  [(= r (+ row 2)) '()]
                  [(= c (+ col 2)) (iter (+ 1 r) (- col 1))]
                  [(and (= r row) (= c col)) (iter r (+ 1 c))]
                  (else
                   (let ([neighbor (get-cell board (list r c))])
                     (if (not (null? neighbor)) (cb neighbor) #f))
                   (iter r (+ 1 c)))))])
      (iter (- row 1) (- col 1)))))

(define map-board
  (lambda (board cb)
    (map (lambda (row)
           (map cb row))
         board)))

(define num-alive-neighbors
  (lambda (board cell)
    (define num-alive 0)
    (iter-neighbors
     board
     cell
     (lambda (cell)
       (if (is-alive cell) (set! num-alive (+ 1 num-alive)) #f)))
    num-alive))
       
(define update-board
  (lambda (board)
    (map-board board
               (lambda (cell)
                 (cond [(is-alive cell)
                        (cond
                          [(< (num-alive-neighbors board cell) 2) (die cell)]
                          [(< (num-alive-neighbors board cell) 4) (live cell)]
                          (else (die cell)))]
                       [(and (is-dead cell) (= (num-alive-neighbors board cell) 3))
                        (live cell)]
                       (else (die cell)))))))

(define SCALE 5)

(define make-image
  (lambda (board)
    (let ([img (rectangle (* (rows board) SCALE) (* (cols board) SCALE) "solid" "white")])
      (map-board board
                 (lambda (cell)
                   (if (is-alive cell)
                       (set! img
                             (underlay/xy
                              img
                              (* (car (get-cord cell)) (+ SCALE 1))
                              (* (cadr (get-cord cell)) (+ SCALE 1))
                              (square (- SCALE 2) "solid" "black")))
                       #f)))
      img)))
 
(define game-of-life
  (lambda (board refresh-rate)
    (animate (lambda (n)
               (cond [(= (modulo n refresh-rate) 0)
                      (set! board (update-board board))
                      (make-image board)]
                     (else
                      (make-image board)))))))


(define cross
  (lambda (col row)
    (map-board (make-board col row)
               (lambda (cell)
                 (if (or
                      (= (car (get-cord cell))
                         (cadr (get-cord cell)))
                      (= (- (- col 1) (car (get-cord cell)))
                         (cadr (get-cord cell))))
                     (live cell)
                     (die cell))))))


; This is faster than big-bang.
;(game-of-life (cross 100s 100) 2)

(big-bang (cross 100 100)
          (on-tick update-board 0.25)
          (to-draw make-image)
          (record? #t))