Conway's Game of Life in Racket

conways.rkt

#lang racket

(define (make-grid rows columns)
  (build-vector rows (lambda (r) (make-vector columns 0))))

(define (rows grid) (vector-length grid))
(define (columns grid) (vector-length (vector-ref grid 0)))

(define (cell grid row column)
  (cond [(or (< row 0) (< column 0)) 0]
        [(or (>= row (rows grid)) (>= column (columns grid))) 0]
        [else (vector-ref (vector-ref grid row) column)]))

(define (neighbors grid row column)
  (for/list ([nrow (in-range (- row 1) (+ row 2))]
             #:when #t
             [ncol (in-range (- column 1) (+ column 2))]
             #:when (not (and (= row nrow) (= column ncol))))
    (cell grid nrow ncol)))

(define (step-cell grid row column)
  (let ([current (cell grid row column)]
        [others (apply + (neighbors grid row column))])
    (cond [(and (= current 1) (< others 2)) 0]
          [(and (= current 1) (or (= others 2) (= others 3))) 1]
          [(and (= current 1) (> others 3)) 0]
          [(and (= current 0) (= others 3)) 1]
          [else 0])))

(define (step-grid grid)
  (for/vector ([row (rows grid)])
    (for/vector ([column (columns grid)])
      (step-cell grid row column))))

(define (print-grid grid)
  (for ([line grid])
    (displayln (string-join (vector->list (vector-map ~a line))))))

(define (run-game grid steps-left)
  (when (not (= steps-left 0))
      (begin
        (display "\r")
        (for ([i (rows grid)]) (display "\033[A"))
        (print-grid grid)
        (sleep 0.5)
        (run-game (step-grid grid) (- steps-left 1)))))

(define test-grid #(#(0 0 0 0 0 0 0)
                    #(0 1 0 0 0 0 0)
                    #(0 0 1 0 0 0 0)
                    #(1 1 1 0 0 0 0)
                    #(0 0 0 0 0 0 0)
                    #(0 0 0 0 0 0 0)
                    #(0 0 0 0 0 0 0)))

(print-grid test-grid)
(run-game test-grid 20)