1 files changed, 100 insertions, 0 deletions
diff --git a/day05.lisp b/day05.lisp
new file mode 100644
index 0000000..5a5fc4e
--- /dev/null
+++ b/day05.lisp
@@ -0,0 +1,100 @@
+(defun parse-integers (string &key (start 0))
+  (loop for i = start then (cadr o)
+        as o = (multiple-value-list (parse-integer string :start i :junk-allowed t))
+        as n = (car o)
+        while n
+        collect n))
+
+(defstruct problem
+  seeds
+  maps)
+
+(defun parse-map (stream)
+  ;; Ignore empty lines + title-line
+  (loop for line = (read-line stream nil 'eof)
+        until (eq line 'eof)
+        until (> (length line) 0))
+  ;; Read integers for map
+  (loop for line = (read-line stream nil 'eof)
+        until (eq line 'eof)
+        while (> (length line) 0)
+        collect (parse-integers line)))
+
+(defun parse-problem (f)
+  (with-open-file (s f)
+    (let* ((seeds (let ((str (read-line s)))
+                    (parse-integers str :start (1+ (position #\: str)))))
+           (maps (loop for map = (parse-map s)
+                       while map
+                       collect map)))
+      (make-problem :seeds seeds
+                    :maps maps))))
+
+(defun map-match (map value)
+  (let ((aux (loop for range in map
+                   as l = (caddr range)
+                   as s = (cadr range)
+                   as d = (car range)
+                   if (and (>= value s) (< value (+ s l)))
+                     return (+ d (- value s)))))
+    (if aux
+        aux
+        value)))
+
+(defun seed-to-location (problem seed)
+  (reduce (lambda (value item) (map-match item value))
+          (problem-maps problem)
+          :initial-value seed))
+
+(defun solve1 (f)
+  (let ((problem (parse-problem f)))
+    (loop for seed in (problem-seeds problem)
+          minimize (seed-to-location problem seed))))
+
+(defun map-ranges (start length map)
+  (when (> length 0)
+    (if map
+      (let* ((range (car map))
+             (rdest (car range))
+             (rstart (cadr range))
+             (rlength (caddr range))
+             (end (1- (+ start length)))
+             (rend (1- (+ rstart rlength))))
+        (cond
+          ;; no overlap
+          ((or (< end rstart) (< rend start))
+           (map-ranges start length (cdr map)))
+          ;; inner overlap
+          ((and (>= start rstart) (<= end rend))
+           (list (cons (+ rdest (- start rstart)) length)))
+          ;; outer overlap
+          ((and (>= rstart start) (<= rend end))
+           (append (map-ranges start (- rstart start) (cdr map))
+                   (list (cons rdest rlength))
+                   (map-ranges (1+ rend) (- end rend) (cdr map))))
+          ;; right overlap
+          ((and (>= rstart start) (<= end rend))
+           (append (map-ranges start (- rstart start) (cdr map))
+                   (list (cons rdest (1+ (- end rstart))))))
+          ;; left overlap
+          ((and (>= start rstart) (<= rend end))
+           (append (list (cons (+ rdest (- start rstart)) (1+ (- rend start))))
+                   (map-ranges (1+ rend) (- end rend) (cdr map))))))
+      (list (cons start length)))))
+
+(defun seed-range-to-min-location (start length maps)
+  (if maps
+      (loop for range in (map-ranges start length (car maps))
+            if range
+              minimize (seed-range-to-min-location (car range) (cdr range) (cdr maps)))
+      start))
+
+(defun solve2 (f)
+  (let ((problem (parse-problem f)))
+    (loop for (start length) on (problem-seeds problem) by #'cddr
+          minimize (seed-range-to-min-location start length (problem-maps problem)))))
+
+(print (solve1 "data/05/example.txt")) ;; 35
+(print (solve1 "data/05/input.txt"))   ;; 579439039
+(print (solve2 "data/05/example.txt")) ;; 46
+(print (solve2 "data/05/input.txt"))   ;; 7873084