From 51a6d1e923503ed0cac7199fb812f6b316643e70 Mon Sep 17 00:00:00 2001 From: Aryadev Chavali Date: Wed, 30 Oct 2024 22:34:04 +0000 Subject: Solve puzzle 11 2022. --- 2022/puzzle-11.lisp | 116 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 116 insertions(+) create mode 100644 2022/puzzle-11.lisp (limited to '2022') 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))) -- cgit v1.2.3-13-gbd6f