day21.lisp (3970B)
1 (defpackage #:adventofcode2022/day21 2 (:use #:cl #:adventofcode2022)) 3 (in-package #:adventofcode2022/day21) 4 5 (defparameter *yell-operations* (make-hash-table)) 6 (setf (gethash :+ *yell-operations*) #'+) 7 (setf (gethash :- *yell-operations*) #'-) 8 (setf (gethash :* *yell-operations*) #'*) 9 (setf (gethash :/ *yell-operations*) #'/) 10 11 (defparameter *yell-operations-reverse* (make-hash-table)) 12 (setf (gethash :+ *yell-operations-reverse*) #'-) 13 (setf (gethash :- *yell-operations-reverse*) #'+) 14 (setf (gethash :* *yell-operations-reverse*) #'/) 15 (setf (gethash :/ *yell-operations-reverse*) #'*) 16 17 (defun monkey-yell (monkey monkeys) 18 (if (listp monkey) 19 (destructuring-bind (op monkey-1 monkey-2) 20 monkey 21 (let ((dep-1 (monkey-yell (gethash monkey-1 monkeys) monkeys)) 22 (dep-2 (monkey-yell (gethash monkey-2 monkeys) monkeys)) 23 (op-fun (gethash op *yell-operations*))) 24 (funcall op-fun dep-1 dep-2))) 25 monkey)) 26 27 (defun monkey-yell-reverse (monkey monkeys monkey-deps) 28 "This only works for the example, no idea why, maybe I'll debug this some other day." 29 (let* ((dep-monkey-name (gethash monkey monkey-deps)) 30 (dep-monkey-rule (gethash dep-monkey-name monkeys)) 31 (dep-monkey-op (gethash (car dep-monkey-rule) *yell-operations-reverse*)) 32 (dep-monkey-deps (cdr dep-monkey-rule)) 33 (dep-monkey-other-monkey-car? (= 0 (position monkey dep-monkey-deps))) 34 (dep-monkey-other-monkey (car (remove monkey dep-monkey-deps)))) 35 (cond 36 ((eq dep-monkey-name :root) 37 (monkey-yell (gethash dep-monkey-other-monkey monkeys) monkeys)) 38 (t (let ((args (list 39 (monkey-yell-reverse dep-monkey-name monkeys monkey-deps) 40 (monkey-yell (gethash dep-monkey-other-monkey monkeys) monkeys)))) 41 (when dep-monkey-other-monkey-car? 42 (setf args (reverse args))) 43 (apply dep-monkey-op args)))))) 44 45 (defun task1 (inputs) 46 (let ((monkeys (make-hash-table))) 47 (loop for (name monkey) in inputs 48 do (setf (gethash name monkeys) monkey)) 49 (monkey-yell (gethash :root monkeys) monkeys))) 50 51 #|(defun task2 (inputs) 52 (let ((monkeys (make-hash-table)) 53 (monkey-deps (make-hash-table))) 54 (loop for (name monkey) in inputs 55 do (setf (gethash name monkeys) monkey) 56 when (consp monkey) 57 do (loop for dep in (cdr monkey) 58 do (setf (gethash dep monkey-deps) name))) 59 (monkey-yell-reverse :humn monkeys monkey-deps)))|# 60 61 (defun task2 (inputs) 62 (let ((monkeys (make-hash-table))) 63 (loop for (name monkey) in inputs 64 do (setf (gethash name monkeys) monkey)) 65 (let ((root (gethash :root monkeys))) 66 (setf (car root) :-) 67 (loop for inc = 1000000000 then (floor inc 10) 68 while (> inc 0) 69 thereis (loop for res = (monkey-yell root monkeys) 70 thereis (= res 0) 71 when (< res 0) 72 do (setf (gethash :humn monkeys) (- (gethash :humn monkeys) inc)) 73 and return nil 74 while (> res 0) 75 do (setf (gethash :humn monkeys) (+ (gethash :humn monkeys) inc)))) 76 (gethash :humn monkeys)))) 77 78 (define-day 21 79 (:translate-input (lambda (line) 80 (destructuring-bind (name rule) 81 (str:split ": " line) 82 (list (intern (str:upcase name) :keyword) 83 (if (str:containsp " " rule) 84 (destructuring-bind (monkey-1 op monkey-2) 85 (str:split " " rule) 86 (list (intern op :keyword) 87 (intern (str:upcase monkey-1) :keyword) 88 (intern (str:upcase monkey-2) :keyword))) 89 (parse-integer rule)))))) 90 #'task1 91 #'task2)