| 1 | (asdf:load-system :adventofcode2020) |
| 2 | (in-package #:adventofcode2020) |
| 3 | (named-readtables:in-readtable :adventofcode2020) |
| 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) |