aboutsummaryrefslogtreecommitdiffstats
path: root/AoC2023
diff options
context:
space:
mode:
Diffstat (limited to 'AoC2023')
-rw-r--r--AoC2023/day05/solver.lisp158
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) #'<))