X-Git-Url: http://git.jkinsey.net/?p=adventofcode2020.git;a=blobdiff_plain;f=src%2Fday11.lisp;fp=src%2Fday11.lisp;h=f5641dcbb59932106d6de5098e783108fe44d471;hp=0000000000000000000000000000000000000000;hb=955fe99709e9fd567d2a296e8eee7a1c459ea439;hpb=32679abfe9a9ade5db5353b7b678db53af95e78e

diff --git a/src/day11.lisp b/src/day11.lisp
new file mode 100644
index 0000000..f5641dc
--- /dev/null
+++ b/src/day11.lisp
@@ -0,0 +1,162 @@
+(asdf:load-system :adventofcode2020)
+(in-package #:adventofcode2020)
+(named-readtables:in-readtable fn-reader)
+
+(defun parse-layout (layout)
+  (make-array (list (length layout) (length (car layout)))
+              :initial-contents layout))
+
+(defun get-surr (game)
+  (lambda (i j)
+    (if (char= #\. (aref game i j)) -1
+      (->>
+        (map-product λ(list (funcall _0 i) (funcall _1 j))
+                     (list #'identity #'1+ #'1-)
+                     (list #'identity #'1+ #'1-)) 
+        (remove-if-not λ(apply #'array-in-bounds-p game _)) 
+        (mapcar λ(apply #'aref game _))
+        (count #\#)))))
+
+(defun get-sightlines (game)
+  (let ((functions (map-product #'list
+                    (list #'identity #'1+ #'1-)
+                    (list #'identity #'1+ #'1-))))
+    (lambda (i j)
+      (if (char= #\. (aref game i j)) -1
+          (loop for (f g) in functions
+                counting 
+                 (do ((fi (funcall f i) (funcall f fi))
+                      (gj (funcall g j) (funcall g gj)))
+                     ((or (not (array-in-bounds-p game fi gj))
+                          (not (char= #\. (aref game fi gj)))
+                          (and (= i fi) (= j gj)))
+                      (when (array-in-bounds-p game fi gj)
+                        (char= #\# (aref game fi gj))))))))))
+
+(defun step-game (game &key (surr #'get-surr))
+  (destructuring-bind (row col) (array-dimensions game)
+    (let* ((get-surr (funcall surr game))
+           (seat-limit (if (eq surr #'get-surr) 5 6))
+           (calc-next (lambda (i j)
+                        (let ((occ (funcall get-surr i j))
+                              (val (aref game i j))) 
+                          (cond ((=  occ 0) #\#) 
+                                ((>= occ seat-limit) #\L)
+                                (t val))))))
+      (->> 
+        (loop for i below row collecting 
+              (loop for j below col collecting (list i j)))
+        (mapcar λ(mapcar (curry #'apply calc-next) _)) 
+        (parse-layout)))))
+
+(defun fixed-point (game &key (surr #'get-surr))
+  (let ((step (step-game game :surr surr)))
+    (if (equalp game step) game
+        (fixed-point step :surr surr))))
+
+(defun count-occupied (game)
+  (loop for i below (array-dimension game 0)
+        summing (loop for j below (array-dimension game 1)
+                      counting (char= #\# (aref game i j)))))
+
+(day 11 input
+  (let ((game (parse-layout (list-from input))))
+    (part1 (count-occupied (fixed-point game :surr #'get-surr)))
+    (part2 (count-occupied (fixed-point game :surr #'get-sightlines)))))
+
+(def-suite day11)
+(in-suite day11)
+
+(defvar *simple-layout*
+  '("L.LL.LL.LL"
+    "LLLLLLL.LL"
+    "L.L.L..L.."
+    "LLLL.LL.LL"
+    "L.LL.LL.LL"
+    "L.LLLLL.LL"
+    "..L.L....."
+    "LLLLLLLLLL"
+    "L.LLLLLL.L" 
+    "L.LLLLL.LL"))
+
+(test get-sightlines
+  (is (equal 8 (funcall (get-sightlines 
+                          (parse-layout '(".......#."
+                                          "...#....."
+                                          ".#......."
+                                          "........."
+                                          "..#L....#"
+                                          "....#...."
+                                          "........."
+                                          "#........"
+                                          "...#....."))) 4 3)))
+  (is (equal 0 (funcall (get-sightlines 
+                          (parse-layout '("............."
+                                          ".L.L.#.#.#.#."
+                                          "............."))) 1 1)))
+  (is (equal 0 (funcall (get-sightlines 
+                          (parse-layout '(".##.##."
+                                          "#.#.#.#"
+                                          "##...##"
+                                          "...L..."
+                                          "##...##"
+                                          "#.#.#.#"
+                                          ".##.##."))) 3 3))))
+
+(test step-game
+  (is (equalp
+        (parse-layout '("#.LL.L#.##"
+                        "#LLLLLL.L#"
+                        "L.L.L..L.."
+                        "#LLL.LL.L#"
+                        "#.LL.LL.LL"
+                        "#.LLLL#.##"
+                        "..L.L....."
+                        "#LLLLLLLL#"
+                        "#.LLLLLL.L"
+                        "#.#LLLL.##"))
+        (step-game (step-game (parse-layout *simple-layout*)))))
+  (is (equalp
+        (parse-layout '("#.LL.LL.L#"
+                        "#LLLLLL.LL"
+                        "L.L.L..L.."
+                        "LLLL.LL.LL"
+                        "L.LL.LL.LL"
+                        "L.LLLLL.LL"
+                        "..L.L....."
+                        "LLLLLLLLL#"
+                        "#.LLLLLL.L"
+                        "#.LLLLL.L#"))
+        (step-game (step-game (parse-layout *simple-layout*) 
+                              :surr #'get-sightlines) 
+                   :surr #'get-sightlines))))
+
+(test fix
+  (is (equalp
+        (parse-layout '("#.#L.L#.##"
+                        "#LLL#LL.L#"
+                        "L.#.L..#.."
+                        "#L##.##.L#"
+                        "#.#L.LL.LL"
+                        "#.#L#L#.##"
+                        "..L.L....."
+                        "#L#L##L#L#"
+                        "#.LLLLLL.L"
+                        "#.#L#L#.##"))
+        (fixed-point (parse-layout *simple-layout*))))
+  (is (equalp
+        (parse-layout '("#.L#.L#.L#"
+                        "#LLLLLL.LL"
+                        "L.L.L..#.."
+                        "##L#.#L.L#"
+                        "L.L#.LL.L#"
+                        "#.LLLL#.LL"
+                        "..#.L....."
+                        "LLL###LLL#"
+                        "#.LLLLL#.L"
+                        "#.L#LL#.L#"))
+        (fixed-point (parse-layout *simple-layout*)
+                     :surr #'get-sightlines))))
+
+
+(run! 'day11)