diff options
Diffstat (limited to 'AoC2023')
| -rw-r--r-- | AoC2023/day05/solver.lisp | 158 |
1 files changed, 121 insertions, 37 deletions
diff --git a/AoC2023/day05/solver.lisp b/AoC2023/day05/solver.lisp index be9008e..47eb491 100644 --- a/AoC2023/day05/solver.lisp +++ b/AoC2023/day05/solver.lisp @@ -1,4 +1,4 @@ -(ql:quickload '(fiveam str)) +(ql:quickload '(fiveam str arrows)) (defparameter eg-input "seeds: 79 14 55 13 @@ -34,39 +34,30 @@ humidity-to-location map: 60 56 37 56 93 4") +(defun parse-rules (rule) + (destructuring-bind (dest source span) rule + (list source (+ source span) (- dest source)))) (defun translate (rules value) (dolist (rule rules) - (destructuring-bind (dest source span) rule - (when (<= source value (+ source (1- span))) - (return-from translate (+ (- value source) dest))))) + (destructuring-bind (start end offset) rule + (when (<= start value (1- end)) + (return-from translate (+ value offset))))) value) -(defun segment-translate (rules segments) - (let ((sorted-rules (sort rules #'< :key #'cadr))) - (mapcan - (lambda (segment) - (destructuring-bind (start . end) segment - (loop for (dest-start source-start span) in sorted-rules - - ))) - segments))) - -(sort '((50 98 2) (52 50 48)) #'< :key #'cadr) +(defun transformation-in-order-p (names) + (loop for (one two) on names + for start = (cadr (str:split "-TO-" (symbol-name one))) + for end = (car (str:split "-TO-" (symbol-name two))) + always (or (string-equal start end) (null two)))) (fiveam:test parts - (let ((rules '((50 98 2) (52 50 48)))) + (let ((rules (mapcar #'parse-rules '((50 98 2) (52 50 48))))) (fiveam:is (= 9 (translate rules 9))) (fiveam:is (= 61 (translate rules 59))) - (fiveam:is (= 51 (translate rules 99))))) - -(defun translator (translate-chain translator-rules) - (lambda (value) - (reduce - (lambda (acc fn) - (translate (gethash fn translator-rules) acc)) - translate-chain - :initial-value value))) + (fiveam:is (= 51 (translate rules 99)))) + (fiveam:is-true + (transformation-in-order-p '(a-to-b b-to-c c-to-goal)))) (defun parser (lines) (let (seeds @@ -80,23 +71,91 @@ humidity-to-location map: (mapcar #'parse-integer (cdr (str:split-omit-nulls #\Space line))))) ((str:ends-with-p "map:" line) (push (read-from-string line) maps-stack)) - ((push (mapcar #'parse-integer (str:split-omit-nulls #\Space line)) + ((push (parse-rules (mapcar #'parse-integer (str:split-omit-nulls #\Space line))) (gethash (car maps-stack) translators))))) - (values (translator - (nreverse maps-stack) - translators) - seeds))) + + (loop for rule-name being the hash-key of translators do + (setf (gethash rule-name translators) + (sort (gethash rule-name translators) #'< :key #'car))) + (setf maps-stack (nreverse maps-stack)) + (transformation-in-order-p maps-stack) + (values maps-stack translators seeds))) + + +(defun translate-range (rules ranges &optional translated-ranges) + "It assumes rules are in order." + (if (or (endp rules) (endp ranges)) + (sort (append ranges translated-ranges) #'< :key #'car) + (destructuring-bind (rule-start rule-end rule-offset) (car rules) + (destructuring-bind (element-start element-end) (car ranges) + (cond + ;; element right sided to rule range thus move to next rule + ((<= rule-end element-start) + (translate-range (cdr rules) ranges translated-ranges)) + ;; element is left sided to rule, thus identity map the range + ((<= element-end rule-start) + (translate-range rules + (cdr ranges) + (cons (car ranges) translated-ranges))) + ;; element range is fully contained, thus map offset + ((<= rule-start element-start element-end rule-end) + (translate-range rules + (cdr ranges) + (cons (list (+ rule-offset element-start) + (+ rule-offset element-end)) + translated-ranges))) + ;; element overlaps on the left of range, thus slice it, + ;; identity map first part, pass the overlap for it to translate on next level + ((< element-start rule-start) + (translate-range rules + (cons (list rule-start element-end) + (cdr ranges)) + (cons (list element-start rule-start) + translated-ranges))) + ;; element overlaps on the right of the range, thus slice it, + ;; offset map first part, transfer remainder for next rule + ((< rule-end element-end) + (translate-range (cdr rules) + (cons (list rule-end element-end) + (cdr ranges)) + (cons (list (+ rule-offset element-start) + (+ rule-offset element-end)) + translated-ranges))) + ((assert nil nil "Not all cases processed"))))))) + + +(defun translator (translate-chain translator-rules) + (lambda (value) + (reduce + (lambda (acc fn) + (print (list fn acc)) + (translate (gethash fn translator-rules) acc)) + translate-chain + :initial-value value))) (defun solver1 (lines) - (multiple-value-bind (translator seeds) (parser lines) - (apply #'min (mapcar translator seeds)))) + (multiple-value-bind (maps-stack translator seeds) (parser lines) + (apply #'min (mapcar (translator maps-stack translator) seeds)))) +(defun seed-to-ranges (seeds) + (arrows:-> + (loop for (start span) on seeds by #'cddr + collect (list start (+ start span))) + (sort #'< :key #'car))) (defun solver2 (lines) - (multiple-value-bind (translator seeds) (parser lines) - (loop for (start span) on seeds by #'cddr - minimize (loop for i from start below (+ start span) - minimize (funcall translator i))))) + (multiple-value-bind (maps-stack translator seeds) (parser lines) + (print (list 'seeds (seed-to-ranges seeds))) + (arrows:-<> + (reduce + (lambda (acc fn) + (let ((res + (translate-range (gethash fn translator) acc))) + (print (list fn res)) + res)) + maps-stack + :initial-value (seed-to-ranges seeds)) + (reduce #'min <> :key #'car)))) (fiveam:test solutions (fiveam:is @@ -114,4 +173,29 @@ humidity-to-location map: (fiveam:is (= 52510809 (solver2 - (uiop:read-file-lines "input"))))) + (uiop:read-file-lines "input")))) + ) + +;; (multiple-value-bind (maps-stack translator seeds) (parser +;; ;; (uiop:split-string eg-input :separator '(#\Newline)) +;; (uiop:read-file-lines "input") +;; ) +;; (arrows:-<> +;; (reduce +;; (lambda (acc fn) +;; (let ((res +;; (translate-range (gethash fn translator) acc))) +;; (print (list fn res)) +;; res)) +;; maps-stack +;; :initial-value (mapcar +;; (lambda (s) (list s (1+ s))) +;; seeds)) +;; ;; (reduce #'min <> :key #'car) +;; )) + +(multiple-value-bind (maps-stack translator seeds) (parser + ;; (uiop:split-string eg-input :separator '(#\Newline)) + (uiop:read-file-lines "input") + ) + (sort (mapcar (translator maps-stack translator) seeds) #'<)) |