(ql:quickload '(fiveam str))

(defparameter eg-input "seeds: 79 14 55 13

seed-to-soil map:
50 98 2
52 50 48

soil-to-fertilizer map:
0 15 37
37 52 2
39 0 15

fertilizer-to-water map:
49 53 8
0 11 42
42 0 7
57 7 4

water-to-light map:
88 18 7
18 25 70

light-to-temperature map:
45 77 23
81 45 19
68 64 13

temperature-to-humidity map:
0 69 1
1 0 69

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 (start end offset) rule
      (when (<= start value (1- end))
        (return-from translate (+ value offset)))))
  value)

(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 (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))))
  (fiveam:is-true
   (transformation-in-order-p '(a-to-b b-to-c c-to-goal))))

(defun parser (lines)
  (let (seeds
        maps-stack
        (translators (make-hash-table)))
    (dolist (line lines)
      (cond
        ((str:emptyp line))
        ((str:starts-with? "seeds:" line)
         (setf seeds
               (mapcar #'parse-integer (cdr (str:split-omit-nulls #\Space line)))))
        ((str:ends-with-p "map:" line)
         (push (read-from-string line) maps-stack))
        ((push (parse-rules (mapcar #'parse-integer (str:split-omit-nulls #\Space line)))
               (gethash (car maps-stack) translators)))))

    (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 rule-end))
                                    translated-ranges)))
            ((assert nil nil "Not all cases processed")))))))

(fiveam:test range-translation
  (let ((single-rule '((5 10 3))))
    (fiveam:is (equal '((16 18)) (translate-range single-rule '((16 18))))
               "Right sided element")
    (fiveam:is (equal '((1 4)) (translate-range single-rule '((1 4))))
               "Left sided element")
    (fiveam:is (equal '((9 11)) (translate-range single-rule '((6 8))))
               "Fully contained")
    (fiveam:is (equal '((3 5) (8 10)) (translate-range single-rule '((3 7))))
               "Left overlap")
    (fiveam:is (equal '((10 13) (12 13)) (translate-range single-rule '((9 13))))
               "Right overlap")))

(defun translator (translate-chain translator-rules)
  (lambda (value)
    (reduce
     (lambda (acc fn)
       (translate (gethash fn translator-rules) acc))
     translate-chain
     :initial-value value)))

(defun solver1 (lines)
  (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 (maps-stack translator seeds) (parser lines)
    (caar
     (reduce
      (lambda (acc fn)
        (translate-range (gethash fn translator) acc))
      maps-stack
      :initial-value (seed-to-ranges seeds)))))

(fiveam:test solutions
  (fiveam:is
   (= 35
      (solver1
       (uiop:split-string eg-input :separator '(#\Newline)))))
  (fiveam:is
   (= 46
      (solver2
       (uiop:split-string eg-input :separator '(#\Newline)))))
  (fiveam:is
   (= 662197086
      (solver1
       (uiop:read-file-lines "input"))))
  (fiveam:is
   (= 52510809
      (solver2
       (uiop:read-file-lines "input")))))