lab7-ips-soln.rkt

(require 2htdp/image)
(require 2htdp/universe)

(define PMAX 10)
(define CELL-SIZE 30)

(define-struct cell (value polluted? x y))
;; make-cell: number boolean number number -> cell
;; A cell has a value indicating permeability,
;; a flag indicating whether it has been polluted yet
;; and two numbers indicating the cell's position in the
;; matrix
(define c1 (make-cell 0 false 0 0))
(define c2 (make-cell 5 false 2 1))
(define c3 (make-cell 7 false 1 2))
(define FAKE-CELL (make-cell -1 false -1 -1))
;; I use this FAKE-CELL later on as a dummy. It's a bit of kludge, I'm afraid.

;; A matrix is one of 
;; --empty
;; --(cons LOC matrix)
#|(define (matrix-func amat)
  (cond [(empty? amat) ...]
        [(cons? amat) ...
         ... (first amat) ... ; a LOC
         ... (matrix-func (rest amat)) ... ; a Matrix
         ]))|#

;; A LOC is one of
;; --empty
;; --(cons cell LOC)
#|(define (LOC-fun aloc)
  (cond [(empty? aloc) ...]
        [(cons? aloc) ...
         ... (first aloc) ... ; a cell
         ... (LOC-func (rest aloc)) ... ; a LOC
         ]))|#

;; Example of a matrix
(define SAMPLE-CELLS (list
                      (list (make-cell 8 false 0 0) (make-cell 6 false 1 0) 
                            (make-cell 9 false 2 0) (make-cell 3 false 3 0) (make-cell 3 false 4 0))
                      (list (make-cell 4 false 0 1) (make-cell 4 false 1 1) 
                            (make-cell 5 false 2 1) (make-cell 4 false 3 1) (make-cell 3 false 4 1))
                      (list (make-cell 1 false 0 2) (make-cell 0 false 1 2) 
                            (make-cell 0 true 2 2) (make-cell 5 false 3 2) (make-cell 0 false 4 2))
                      (list (make-cell 2 false 0 3) (make-cell 6 false 1 3) 
                            (make-cell 5 false 2 3) (make-cell 2 false 3 3) (make-cell 0 false 4 3))
                      (list (make-cell 0 false 0 4) (make-cell 2 false 1 4) 
                            (make-cell 1 false 2 4) (make-cell 3 false 3 4) (make-cell 9 false 4 4))))




(define-struct world (cells))
;; make-world: matrix -> world
;; A world is only a matrix of cells.
(define INIT-WORLD (make-world (list (list c1
                                           (make-cell 1 false 1 0)
                                           (make-cell 2 false 2 0))
                                     (list (make-cell 3 false 0 1) 
                                           (make-cell 4 true 1 1)
                                           c2)
                                     (list (make-cell 6 false 0 2) 
                                           c3
                                           (make-cell 8 false 2 2)))))


;; is-middle? number number number number -> boolean
;; is-middle? consumes a total width and height and a position
;; and determines if that position is in the exact middle of the
;; width and height.
(define (is-middle? width height x y)
  (and (= (floor (/ width 2)) x)
       (= (floor (/ height 2)) y)))

(check-expect (is-middle? 5 5 3 3) false)
(check-expect (is-middle? 5 3 5 1) false)
(check-expect (is-middle? 4 2 2 1) true)

;; generate-LOC: number number number number -> LOC
;; This simple function uses a counter to generate a list of cells.
;; The middle cell will be flagged as polluted if it's also
;; in the middle of the matrix.
(define (generate-LOC width height original-width original-height)
  (build-list width (lambda (n) 
                      (make-cell (random PMAX)
                                 (is-middle? original-width
                                             original-height
                                             n
                                             height)
                                 n
                                 height))))

;; generate-matrix: number number number number -> matrix
;; This simple function uses a counter to generate a matrix of cells.
;; The middle cell will be flagged as polluted.
(define (generate-matrix width height original-width original-height)
  (build-list height (lambda (n) 
                       (generate-LOC width
                                     n
                                     width
                                     height))))


;; first*: Matrix -> List-of-numbers
;; Consumes a matrix and produces it's first column of numbers as a list
(define (first* amat)
  (cond [(empty? amat) empty]
        [(cons? amat) (cons (first (first amat))
                            (first* (rest amat)))]))

;; rest*: Matrix -> Matrix
;; Consumes a matrix and produces a matrix with the first column of numbers removed
(define (rest* amat)
  (cond [(empty? amat) empty]
        [(cons? amat) (cons (rest (first amat))
                            (rest* (rest amat)))]))

;; transpose: Matrix -> Matrix
;; Consumes a matrix and produces a transposed version of it. I.e. rows become
;; columns, and columns become rows.
(define (transpose amat)
  (cond [(empty? (first amat)) empty]
        [else (cons (first* amat)
                    (transpose (rest* amat)))]))

;; cell-color: cell -> string
;; This function consumes a cell and produces a string representing it's color
;; based on whether the cell is polluted.
(define (cell-color acell)
  (cond [(cell-polluted? acell) "green"]
        [else "brown"]))

;; cell-font-color: cell -> string
;; This function consumes a cell and produces a string representing the color
;; of the string representing it based on whether the cell is polluted.
(define (cell-font-color acell)
  (cond [(cell-polluted? acell) "black"]
        [else "white"]))

;; draw-cell-permeability: cell -> image
;; This function produces the image of text that appears on top of the
;; image of the cell based on cell's current state.
(define (draw-cell-permeability acell)
  (text (number->string (cell-value acell))
        11
        (cell-font-color acell)))

;; draw-cell: cell -> image
;; This function produces an image of a cell with text overlayed indicating
;; it's current permeability.
(define (draw-cell acell)
  (overlay (draw-cell-permeability acell)
           (rectangle CELL-SIZE ;; Outer rectangle
                      CELL-SIZE 
                      "outline" 
                      "black")
           (rectangle CELL-SIZE ;; Inner rectangle
                      CELL-SIZE 
                      "solid" 
                      (cell-color acell))))

;; draw-LOC: LOC -> image
;; Consumes a list of cells and produces an image representing the entire row.
(define (draw-LOC aloc)
  (cond [(empty? (rest aloc)) (draw-cell (first aloc))]
        [(cons? (rest aloc))
         (beside (draw-cell (first aloc))
                 (draw-LOC (rest aloc)))]))

;; draw-matrix: matrix -> image
;; Consumes a matrix of cells and produces an image representing the entire structure.
(define (draw-matrix amat)
  (cond [(empty? (rest amat)) (draw-LOC (first amat))]
        [(cons? (rest amat))
         (above (draw-LOC (first amat))
                (draw-matrix (rest amat)))]))

;; cells-equal?: cell cell -> boolean
;; Consumes two cells and determines if they are equal. Equality is based on
;; whether they are at the same position.
(define (cells-equal? cell1 cell2)
  (and (= (cell-x cell1)
          (cell-x cell2))
       (= (cell-y cell1)
          (cell-y cell2))))


;; polluted-cell-at?/x: aloc number -> boolean
;; Given a list of cells and a position in that list,
;; determines if that cell is polluted.
(define (polluted-cell-at?/x aloc x)
  (cond [(or (< x 0) (empty? aloc)) false]
        [(= x 0) (cell-polluted? (first aloc))]
        [(> x 0) (polluted-cell-at?/x (rest aloc) 
                                      (sub1 x))]))


;; polluted-cell-at?/xy: matrix number number -> boolean
;; Given a matrix of cells and a position in that matrix,
;; determines if that cell is polluted.
(define (polluted-cell-at?/xy amat x y)
  (cond [(or (< y 0) (empty? amat)) false]
        [(= y 0) (polluted-cell-at?/x (first amat) 
                                      x)]
        [(> y 0) (polluted-cell-at?/xy (rest amat) 
                                       x 
                                       (sub1 y))]))

(check-expect (polluted-cell-at?/xy (world-cells INIT-WORLD) 3 3) false)

;; is-cell-adjacent-to-pollution: cell matrix -> boolean
;; Consumes a matrix and a cell, and determines if the cell has
;; any neighbors that are polluted.
(define (is-cell-adjacent-to-pollution acell amat)
  (or (polluted-cell-at?/xy amat
                            (sub1 (cell-x acell))
                            (cell-y acell))
      (polluted-cell-at?/xy amat
                            (cell-x acell)
                            (sub1 (cell-y acell)))
      (polluted-cell-at?/xy amat
                            (add1 (cell-x acell))
                            (cell-y acell))
      (polluted-cell-at?/xy amat
                            (cell-x acell)
                            (add1 (cell-y acell)))))

(check-expect (is-cell-adjacent-to-pollution c1 (world-cells INIT-WORLD)) false)
(check-expect (is-cell-adjacent-to-pollution c2 (world-cells INIT-WORLD)) true)

;; get-all-adjacent-polluted-cells-in-LOC: LOC matrix -> list-of-cells
;; Consumes a list-of-cells in a matrix (which also needs to be given)
;; and produces the list of cells that are adjacent to polluted ones.
(define (get-all-adjacent-polluted-cells-in-LOC aloc amat)
  (cond [(empty? (rest aloc)) 
         (cond [(is-cell-adjacent-to-pollution (first aloc) 
                                               amat)
                (cons (first aloc) empty)]
               [else empty])]
        [(cons? (rest aloc))
         (cond [(is-cell-adjacent-to-pollution (first aloc) 
                                               amat) 
                (cons (first aloc)
                      (get-all-adjacent-polluted-cells-in-LOC (rest aloc) 
                                                              amat))]
               [else (get-all-adjacent-polluted-cells-in-LOC (rest aloc) 
                                                             amat)])]))

(check-expect (get-all-adjacent-polluted-cells-in-LOC (first (world-cells INIT-WORLD))
                                                      (world-cells INIT-WORLD))
              (cons (make-cell 1 false 1 0) empty))
(check-expect (get-all-adjacent-polluted-cells-in-LOC (second (world-cells INIT-WORLD))
                                                      (world-cells INIT-WORLD))
              (cons (make-cell 3 false 0 1) (cons (make-cell 5 false 2 1) empty)))
(check-expect (get-all-adjacent-polluted-cells-in-LOC (third (world-cells INIT-WORLD))
                                                      (world-cells INIT-WORLD))
              (cons (make-cell 7 false 1 2) empty))

;; get-all-adjacent-polluted-cells-in-matrix: matrix matrix -> list-of-cell
;; Consumes a matrix (the second parameter will always consume the original matrix unmodified)
;; and produces a list of all the cells that are next to polluted cells.
(define (get-all-adjacent-polluted-cells-in-matrix amat originalmat)
  (cond [(empty? (rest amat)) 
         (get-all-adjacent-polluted-cells-in-LOC (first amat) 
                                                 originalmat)]
        [(cons? (rest amat))
         (append (get-all-adjacent-polluted-cells-in-LOC (first amat) 
                                                         originalmat)
                 (get-all-adjacent-polluted-cells-in-matrix (rest amat) 
                                                            originalmat))]))

(check-expect (get-all-adjacent-polluted-cells-in-matrix (world-cells INIT-WORLD) (world-cells INIT-WORLD))
              (cons (make-cell 1 false 1 0) (cons (make-cell 3 false 0 1) (cons (make-cell 5 false 2 1) (cons (make-cell 7 false 1 2) empty)))))

;; get-most-permeable-cell: list-of-cells -> cell
;; Consumes a list of cells and produces the cell that has the highest permeability.
(define (get-most-permeable-cell aloc)
  (cond [(empty? aloc) FAKE-CELL]
        [(empty? (rest aloc)) (first aloc)]
        [(cons? (rest aloc))
         (cond [(and (> (cell-value (first aloc))
                        (cell-value (get-most-permeable-cell (rest aloc))))
                     (not (cell-polluted? (first aloc)))) 
                (first aloc)]
               [else 
                (get-most-permeable-cell (rest aloc))])]))



(check-expect (get-most-permeable-cell (first (world-cells INIT-WORLD))) (make-cell 2 false 2 0))
(check-expect (get-most-permeable-cell empty) (make-cell -1 false -1 -1))

;; is-cell-most-permeable-adjacent: cell matrix -> boolean
;; Checks if the current cell is the most permeable by testing if it
;; is equal to the most permeable cell in the matrix. This is basically
;; the worst way posssible to do this. A vast improvement could be made
;; simply by caching the result of (get-most-permeable-cell ....)
(define (is-cell-most-permeable-adjacent acell amat)
  (cells-equal? acell
                (get-most-permeable-cell 
                 (get-all-adjacent-polluted-cells-in-matrix amat amat))))

(check-expect (is-cell-most-permeable-adjacent c1 (world-cells INIT-WORLD)) false)
(check-expect (is-cell-most-permeable-adjacent c2 (world-cells INIT-WORLD)) false)
(check-expect (is-cell-most-permeable-adjacent c3 (world-cells INIT-WORLD)) true)

;; update-cell: cell matrix -> cell
;; Consumes a cell and the matrix that cell belongs to and updates that cell's
;; pollution state.
(define (update-cell acell amat)
  (make-cell (cell-value acell)
             (or (is-cell-most-permeable-adjacent acell amat)
                 (cell-polluted? acell))
             (cell-x acell)
             (cell-y acell)))

(check-expect (update-cell c1 (world-cells INIT-WORLD)) (make-cell 0 false 0 0))
(check-expect (update-cell c2 (world-cells INIT-WORLD)) (make-cell 5 false 2 1))
(check-expect (update-cell c3 (world-cells INIT-WORLD)) (make-cell 7 true 1 2))

;; update-LOC: LOC matrix-> LOC
;; Consumes a list of cells and the matrix that list of cells belongs to and updates
;; all the cell's pollution states.
(define (update-LOC aloc amat)
  (cond [(empty? (rest aloc)) (cons (update-cell (first aloc) amat) empty)]
        [(cons? (rest aloc))
         (cons (update-cell (first aloc) amat)
               (update-LOC (rest aloc) amat))]))

(check-expect (update-LOC (first (world-cells INIT-WORLD)) (world-cells INIT-WORLD))
              (cons (make-cell 0 false 0 0) (cons (make-cell 1 false 1 0) (cons (make-cell 2 false 2 0) empty))))
(check-expect (update-LOC (third (world-cells INIT-WORLD)) (world-cells INIT-WORLD))
              (cons (make-cell 6 false 0 2) (cons (make-cell 7 true 1 2) (cons (make-cell 8 false 2 2) empty))))

;; update-cells: matrix matrix -> matrix
;; Consumes a matrix and the matrix that first matrix is a sub-matrix of and updates
;; all the cell's pollution states.
(define (update-cells amat originalmat)
  (cond [(empty? (rest amat)) (cons (update-LOC (first amat) originalmat) empty)]
        [(cons? (rest amat))
         (cons (update-LOC (first amat) originalmat)
               (update-cells (rest amat) originalmat))]))
(check-expect (update-cells (world-cells INIT-WORLD) (world-cells INIT-WORLD))
              (cons (cons (make-cell 0 false 0 0) (cons (make-cell 1 false 1 0) (cons (make-cell 2 false 2 0) empty)))
                    (cons (cons (make-cell 3 false 0 1) (cons (make-cell 4 true 1 1) (cons (make-cell 5 false 2 1) empty)))
                          (cons (cons (make-cell 6 false 0 2) (cons (make-cell 7 true 1 2) (cons (make-cell 8 false 2 2) empty)))
                                empty))))


;; update-world-on-tick: world -> world
;; Updates every cell in the world.
(define (update-world-on-tick aworld)
  (make-world (update-cells (world-cells aworld)
                            (world-cells aworld))))

;; draw-world: world-> image
;; Draws all the cells in the world.
(define (draw-world aworld)
  (draw-matrix (world-cells aworld)))

;; is-pollution-in-list?: LOC -> boolean
;; Consumes a list of cells and determines if any of them are polluted.
(define (is-pollution-in-list? aloc)
  (cond [(empty? aloc) false]
        [(cons? aloc) (or (cell-polluted? (first aloc))
                          (is-pollution-in-list? (rest aloc)))]))

;; is-top-edge-polluted?: matrix -> boolean
;; Consumes a matrix and determines if it's first row has any polluted
;; cells in it.
(define (is-top-edge-polluted? amat)
  (is-pollution-in-list? (first amat)))

;; is-bottom-edge-polluted?: matrix -> boolean
;; Consumes a matrix and determines if it's last row has any polluted
;; cells in it.
(define (is-bottom-edge-polluted? amat)
  (cond [(empty? (rest amat)) (is-pollution-in-list? (first amat))]
        [(cons? (rest amat)) (is-bottom-edge-polluted? (rest amat))]))

;; is-right-edge-polluted?: matrix -> boolean
;; Consumes a matrix and determines if the right edge has any polluted
;; cells in it.
(define (is-right-edge-polluted? amat)
  (is-bottom-edge-polluted? (transpose amat)))

;; is-left-edge-polluted?: matrix -> boolean
;; Consumes a matrix and determines if the left edge has any polluted
;; cells in it.
(define (is-left-edge-polluted? amat)
  (is-top-edge-polluted? (transpose amat)))

;; is-edge-polluted?: world -> boolean
;; Consumes a matrix and determiens if any of it's edges have
;; any polluted cells in them.
(define (is-edge-polluted? aworld)
  (or (is-top-edge-polluted? (world-cells aworld))
      (is-bottom-edge-polluted? (world-cells aworld))
      (is-right-edge-polluted? (world-cells aworld))
      (is-left-edge-polluted? (world-cells aworld))))

;; main: number -> world-simulation
;; Consumes an odd number n and starts a simulation of size n.
;; If given an even number, returns an error message.
(define (main n)
  (cond [(even? n) "This simulation only works on odd sizes."]
        [else (big-bang (make-world (generate-matrix n n n n))
                        (on-tick update-world-on-tick 1)
                        (on-draw draw-world)
                        (stop-when is-edge-polluted?))]))