1 (asdf:load-system :adventofcode2020)
2 (in-package #:adventofcode2020)
3 (named-readtables:in-readtable :adventofcode2020)
5 (defun parse-layout (layout)
6 (make-array (list (length layout) (length (car layout)))
7 :initial-contents layout))
11 (if (char= #\. (aref game i j)) -1
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 _))
20 (defun get-sightlines (game)
21 (let ((functions (map-product #'list
22 (list #'identity #'1+ #'1-)
23 (list #'identity #'1+ #'1-))))
25 (if (char= #\. (aref game i j)) -1
26 (loop for (f g) in functions
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))))))))))
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)))
44 ((>= occ seat-limit) #\L)
47 (loop for i below row collecting
48 (loop for j below col collecting (list i j)))
49 (mapcar λ(mapcar (curry #'apply calc-next) _))
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))))
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)))))
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)))))
70 (defvar *simple-layout*
83 (is (equal 8 (funcall (get-sightlines
84 (parse-layout '(".......#."
93 (is (equal 0 (funcall (get-sightlines
94 (parse-layout '("............."
96 "............."))) 1 1)))
97 (is (equal 0 (funcall (get-sightlines
98 (parse-layout '(".##.##."
108 (parse-layout '("#.LL.L#.##"
118 (step-game (step-game (parse-layout *simple-layout*)))))
120 (parse-layout '("#.LL.LL.L#"
130 (step-game (step-game (parse-layout *simple-layout*)
131 :surr #'get-sightlines)
132 :surr #'get-sightlines))))
136 (parse-layout '("#.#L.L#.##"
146 (fixed-point (parse-layout *simple-layout*))))
148 (parse-layout '("#.L#.L#.L#"
158 (fixed-point (parse-layout *simple-layout*)
159 :surr #'get-sightlines))))