Commit | Line | Data |
---|---|---|
955fe997 JK |
1 | (asdf:load-system :adventofcode2020) |
2 | (in-package #:adventofcode2020) | |
59b2be10 | 3 | (named-readtables:in-readtable :adventofcode2020) |
955fe997 JK |
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) |