Solve puzzle 11 2022.

1 files changed, 116 insertions, 0 deletions

diff --git a/2022/puzzle-11.lisp b/2022/puzzle-11.lisp
new file mode 100644
index 0000000..1a55a96
--- /dev/null
+++ b/2022/puzzle-11.lisp
@@ -0,0 +1,116 @@
+(load "lib")
+
+(defparameter input (uiop:read-file-string "11-input"))
+(defparameter lines (get-lines input))
+
+(defun lines->segments (lines)
+  (--> (split-by-completely lines "" #'string=)
+       (mapcar (lambda (x)
+            (--> (loop for i in x
+                       collect
+                       (string-trim '(#\Space) i))))
+          it)))
+
+(defun segment->monkey (segment)
+  (destructuring-bind (name starting op test clause-1 clause-2) segment
+    (declare (ignore name))
+    `(:items
+      ,(--> (subseq starting 16)
+            (string-to-clist it)
+            (split-by-completely it #\,)
+            (mapcar (lambda (lst)
+                 (--> (clist-to-string lst)
+                      (string-trim '(#\Space) it)
+                      (parse-integer it)))
+               it))
+      :inspect
+      ,(--> (subseq op 21)
+            (format nil "(~a old)" it)
+            (with-input-from-string (s it)
+              (read s))
+            (eval `(lambda (old) ,it)))
+      :test
+      ,(let ((test (parse-integer (subseq test 19)))
+             (clause-1 (parse-integer (subseq clause-1 25)))
+             (clause-2 (parse-integer (subseq clause-2 26))))
+         (lambda (n)
+           (if (= (mod n test) 0)
+               clause-1
+               clause-2)))
+      :divisor ,(parse-integer (subseq test 19)))))
+
+(defmacro get-monkey (monkeys ind)
+  `(nth ,ind ,monkeys))
+
+(defmacro get-monkey-items (monkeys ind)
+  `(getf (get-monkey ,monkeys ,ind) :items))
+
+(defun monkey-increment-alist (monkey-alist monkey-ind)
+  (setf (cdr (assoc monkey-ind monkey-alist))
+        (+ 1 (cdr (assoc monkey-ind monkey-alist)))))
+
+(defun monkey-send-item (monkeys item recipient)
+  (setf (get-monkey-items monkeys recipient)
+        (append (get-monkey-items monkeys recipient)
+                (list item))))
+
+(defun monkey-process-item (inspect item)
+  (floor (/ (funcall inspect item) 3)))
+
+(defun monkey-do-turn (monkeys monkey-alist monkey-ind)
+  (let* ((monkey  (nth monkey-ind monkeys))
+         (items   (getf monkey :items))
+         (inspect (getf monkey :inspect))
+         (test    (getf monkey :test)))
+    (loop for item in items
+          for proper-item    = (monkey-process-item inspect item)
+          for recipient      = (funcall test proper-item)
+          do (monkey-send-item monkeys proper-item recipient)
+          do (monkey-increment-alist monkey-alist monkey-ind))
+    (setf (get-monkey-items monkeys monkey-ind) nil)
+    monkeys))
+
+(defun monkeys-do-round (monkeys monkey-alist)
+  (loop for monkey in monkeys
+        for i from 0
+        do (monkey-do-turn monkeys monkey-alist i)))
+
+(defun monkey-business (monkey-alist)
+  (--> (lambda (x y) (> (cdr x) (cdr y)))
+       (sort monkey-alist it)
+       (subseq it 0 2)
+       (mapcar #'cdr it)
+       (reduce #'* it)))
+
+(let* ((monkeys (--> (lines->segments lines)
+                     (mapcar #'segment->monkey it)))
+       (monkey-alist (loop for monkey in monkeys
+                           for i from 0
+                           collect `(,i . 0))))
+
+  (loop for i from 1 to 20
+        do (monkeys-do-round monkeys monkey-alist))
+
+  (format t "Round 1: ~a~%" (monkey-business monkey-alist)))
+
+(defvar *monkey-divisor* nil)
+
+(defun monkey-process-item (inspect item)
+  (mod (funcall inspect item) *monkey-divisor*))
+
+(let* ((monkeys (--> (lines->segments lines)
+                     (mapcar #'segment->monkey it)))
+       (monkey-alist (loop for monkey in monkeys
+                           for i from 0
+                           collect `(,i . 0))))
+
+  ;; To ensure we don't go too hard.
+  (setq *monkey-divisor* (reduce #'*
+                            (loop for monkey in monkeys
+                                  for divisor = (getf monkey :divisor)
+                                  collect divisor)))
+
+  (loop for i from 1 to 10000
+        do (monkeys-do-round monkeys monkey-alist))
+
+  (format t "Round 2: ~a~%" (monkey-business monkey-alist)))