src/day11.lisp

   1 (asdf:load-system :adventofcode2020)
   2 (in-package #:adventofcode2020)
   3 (named-readtables:in-readtable fn-reader)
   4
   5 (defun parse-layout (layout)
   6   (make-array (list (length layout) (length (car layout)))
   7               :initial-contents layout))
   8
   9 (defun get-surr (game)
  10   (lambda (i j)
  11     (if (char= #\. (aref game i j)) -1
  12       (->>
  13         (map-product λ(list (funcall _0 i) (funcall _1 j))
  14                      (list #'identity #'1+ #'1-)
  15                      (list #'identity #'1+ #'1-))
  16         (remove-if-not λ(apply #'array-in-bounds-p game _))
  17         (mapcar λ(apply #'aref game _))
  18         (count #\#)))))
  19
  20 (defun get-sightlines (game)
  21   (let ((functions (map-product #'list
  22                     (list #'identity #'1+ #'1-)
  23                     (list #'identity #'1+ #'1-))))
  24     (lambda (i j)
  25       (if (char= #\. (aref game i j)) -1
  26           (loop for (f g) in functions
  27                 counting
  28                  (do ((fi (funcall f i) (funcall f fi))
  29                       (gj (funcall g j) (funcall g gj)))
  30                      ((or (not (array-in-bounds-p game fi gj))
  31                           (not (char= #\. (aref game fi gj)))
  32                           (and (= i fi) (= j gj)))
  33                       (when (array-in-bounds-p game fi gj)
  34                         (char= #\# (aref game fi gj))))))))))
  35
  36 (defun step-game (game &key (surr #'get-surr))
  37   (destructuring-bind (row col) (array-dimensions game)
  38     (let* ((get-surr (funcall surr game))
  39            (seat-limit (if (eq surr #'get-surr) 5 6))
  40            (calc-next (lambda (i j)
  41                         (let ((occ (funcall get-surr i j))
  42                               (val (aref game i j)))
  43                           (cond ((=  occ 0) #\#)
  44                                 ((>= occ seat-limit) #\L)
  45                                 (t val))))))
  46       (->>
  47         (loop for i below row collecting
  48               (loop for j below col collecting (list i j)))
  49         (mapcar λ(mapcar (curry #'apply calc-next) _))
  50         (parse-layout)))))
  51
  52 (defun fixed-point (game &key (surr #'get-surr))
  53   (let ((step (step-game game :surr surr)))
  54     (if (equalp game step) game
  55         (fixed-point step :surr surr))))
  56
  57 (defun count-occupied (game)
  58   (loop for i below (array-dimension game 0)
  59         summing (loop for j below (array-dimension game 1)
  60                       counting (char= #\# (aref game i j)))))
  61
  62 (day 11 input
  63   (let ((game (parse-layout (list-from input))))
  64     (part1 (count-occupied (fixed-point game :surr #'get-surr)))
  65     (part2 (count-occupied (fixed-point game :surr #'get-sightlines)))))
  66
  67 (def-suite day11)
  68 (in-suite day11)
  69
  70 (defvar *simple-layout*
  71   '("L.LL.LL.LL"
  72     "LLLLLLL.LL"
  73     "L.L.L..L.."
  74     "LLLL.LL.LL"
  75     "L.LL.LL.LL"
  76     "L.LLLLL.LL"
  77     "..L.L....."
  78     "LLLLLLLLLL"
  79     "L.LLLLLL.L"
  80     "L.LLLLL.LL"))
  81
  82 (test get-sightlines
  83   (is (equal 8 (funcall (get-sightlines
  84                           (parse-layout '(".......#."
  85                                           "...#....."
  86                                           ".#......."
  87                                           "........."
  88                                           "..#L....#"
  89                                           "....#...."
  90                                           "........."
  91                                           "#........"
  92                                           "...#....."))) 4 3)))
  93   (is (equal 0 (funcall (get-sightlines
  94                           (parse-layout '("............."
  95                                           ".L.L.#.#.#.#."
  96                                           "............."))) 1 1)))
  97   (is (equal 0 (funcall (get-sightlines
  98                           (parse-layout '(".##.##."
  99                                           "#.#.#.#"
 100                                           "##...##"
 101                                           "...L..."
 102                                           "##...##"
 103                                           "#.#.#.#"
 104                                           ".##.##."))) 3 3))))
 105
 106 (test step-game
 107   (is (equalp
 108         (parse-layout '("#.LL.L#.##"
 109                         "#LLLLLL.L#"
 110                         "L.L.L..L.."
 111                         "#LLL.LL.L#"
 112                         "#.LL.LL.LL"
 113                         "#.LLLL#.##"
 114                         "..L.L....."
 115                         "#LLLLLLLL#"
 116                         "#.LLLLLL.L"
 117                         "#.#LLLL.##"))
 118         (step-game (step-game (parse-layout *simple-layout*)))))
 119   (is (equalp
 120         (parse-layout '("#.LL.LL.L#"
 121                         "#LLLLLL.LL"
 122                         "L.L.L..L.."
 123                         "LLLL.LL.LL"
 124                         "L.LL.LL.LL"
 125                         "L.LLLLL.LL"
 126                         "..L.L....."
 127                         "LLLLLLLLL#"
 128                         "#.LLLLLL.L"
 129                         "#.LLLLL.L#"))
 130         (step-game (step-game (parse-layout *simple-layout*)
 131                               :surr #'get-sightlines)
 132                    :surr #'get-sightlines))))
 133
 134 (test fix
 135   (is (equalp
 136         (parse-layout '("#.#L.L#.##"
 137                         "#LLL#LL.L#"
 138                         "L.#.L..#.."
 139                         "#L##.##.L#"
 140                         "#.#L.LL.LL"
 141                         "#.#L#L#.##"
 142                         "..L.L....."
 143                         "#L#L##L#L#"
 144                         "#.LLLLLL.L"
 145                         "#.#L#L#.##"))
 146         (fixed-point (parse-layout *simple-layout*))))
 147   (is (equalp
 148         (parse-layout '("#.L#.L#.L#"
 149                         "#LLLLLL.LL"
 150                         "L.L.L..#.."
 151                         "##L#.#L.L#"
 152                         "L.L#.LL.L#"
 153                         "#.LLLL#.LL"
 154                         "..#.L....."
 155                         "LLL###LLL#"
 156                         "#.LLLLL#.L"
 157                         "#.L#LL#.L#"))
 158         (fixed-point (parse-layout *simple-layout*)
 159                      :surr #'get-sightlines))))
 160
 161
 162 (run! 'day11)