--- /dev/null
+(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)
projects / adventofcode2020.git / blobdiff