diff options
| -rw-r--r-- | AoC2023/day19/solver.lisp | 37 |
1 files changed, 21 insertions, 16 deletions
diff --git a/AoC2023/day19/solver.lisp b/AoC2023/day19/solver.lisp index 7a95a71..cc24f59 100644 --- a/AoC2023/day19/solver.lisp +++ b/AoC2023/day19/solver.lisp @@ -17,6 +17,11 @@ :a (copy-tree a) :s (copy-tree s)))) +(defun update-part (range-part slot val) + (let ((new (copy-part range-part))) + (setf (slot-value new slot) val) + new)) + (defun part-options (range-part) (reduce #'* '(x m a s) :key (lambda (v) @@ -93,22 +98,22 @@ (if (member start '(A R)) (list start range) (destructuring-bind (df . opts) (gethash start workflows) - (let ((drops (loop for (op prop val target) in opts - append - (destructuring-bind (st . end) (slot-value range prop) - (if (eq '< op) - (cond ((< end val) (part-2 workflows target (copy-part range))) - ((<= val st) nil) - (t (let ((lf (copy-part range))) - (setf (slot-value lf prop) (cons st (1- val)) - (slot-value range prop) (cons val end)) - (part-2 workflows target lf)))) - (cond ((> st val) (part-2 workflows target (copy-part range))) - ((>= val end) nil) - (t (let ((rt (copy-part range))) - (setf (slot-value range prop) (cons st val) - (slot-value rt prop) (cons (1+ val) end)) - (part-2 workflows target rt))))))))) + (let ((drops + (loop for (op prop val target) in opts + append + (destructuring-bind (st . end) (slot-value range prop) + (part-2 workflows target + (if (eq '< op) + (if (< end val) + (copy-part range) + (progn + (setf (slot-value range prop) (cons val end)) + (update-part range prop (cons st (1- val))))) + (if (> st val) + (copy-part range) + (progn + (setf (slot-value range prop) (cons st val)) + (update-part range prop (cons (1+ val) end)))))))))) (append (part-2 workflows df range) drops))))) |