Refactor 2023/05

src/2023/day05.lisp

@@ -1,6 +1,7 @@
 (defpackage :aoc/2023/05 #.cl-user::*aoc-use*)
 (in-package :aoc/2023/05)
 
+
 (defun parse-map (strings)
   (bnd1 (ranges (looping
                   (dolist (range (rest strings))
@@ -11,59 +12,56 @@
     (cons
       (list 0 0 (first (first ranges)))
       ranges)))
-#+#:excluded (parse-map "seed-to-soil map:
-50 98 2
-52 50 48")
-
-(defun find-range (seed ranges)
-  (find-if [<= (first _) seed (+ (first _) (third _))] ranges))
 
-(defun part1 (&optional (strings (uiop:read-file-lines #P"src/2023/day05.txt")))
+(defun parse-input (&optional (strings (uiop:read-file-lines #P"src/2023/day05.txt")))
   (destructuring-bind (seeds &rest maps)
       (split-sequence:split-sequence "" strings :test #'string=)
-    (setf seeds (extract-positive-integers (first seeds))
-          maps (mapcar #'parse-map maps))
-    (looping
-      (dolist (seed seeds)
-        (dolist (map maps)
-          (bnd1 ((source dest ignore) (or (find-range seed map)
-                                          (list seed seed 1)))
-            (setf seed (+ (- seed source) dest))))
-        (minimize! seed)))))
-#+#:excluded (part1)
-600279879
+    (cons
+      (extract-positive-integers (first seeds))
+      (mapcar #'parse-map maps))))
 
-(defun seed-ranges (seeds)
-  (loop with seeds = seeds
-        for seed1 in seeds by #'cddr
-        for seed2 in (cdr seeds) by #'cddr
-        collect (list seed1 seed2)))
-#+#:excluded (seed-ranges (list 1 2 3 4 5 6))
 
-(defun part2 (&optional (strings (uiop:read-file-lines #P"src/2023/day05.txt")))
-  (declare (optimize (debug 3)))
-  (destructuring-bind (seeds &rest maps)
-      (split-sequence:split-sequence "" strings :test #'string=)
-    (setf seeds (seed-ranges (parse-positive-integers (first seeds)))
-          maps (mapcar #'parse-map maps))
-    (dolist (map maps seeds)
-      (bnd1 (seeds-next)
-        (doseq ((start length) seeds)
-          (loop while (> length 0) do
-                (bnd* (((source dest size) (or (find-range start map)
-                                               (list start start length)))
-                       (new-length (if (> (+ start length) (+ source size))
-                                     (- size (- start source))
-                                     length)))
-                  (push (list (+ (- start source) dest)
-                              new-length)
-                        seeds-next)
-                  (setf start (+ start new-length 1)
-                        length (- length new-length)))))
-        (setf seeds seeds-next)))))
+(defun find-range (seed ranges)
+  (find-if (lambda (range)
+             (bnd* ((start (first range))
+                    (end (+ start (third range) -1)))
+               (and (<= start seed end))))
+           ranges))
+
+(defun unmapped-range (start &optional (size 1)) (list start start size))
+
+(defun part1 (&optional (input (parse-input))
+                        &aux (seeds (car input)) (maps (cdr input)))
+  (looping
+    (dolist (seed seeds)
+      (dolist (map maps)
+        (destructuring-bind (source dest _) (or (find-range seed map)
+                                                (unmapped-range seed))
+          (declare (ignore _))
+          (setf seed (+ (- seed source) dest))))
+      (minimize! seed))))
+
+
+(defun part2 (&optional (input (parse-input))
+                        &aux (ranges (subdivide (car input) 2)) (maps (cdr input)))
+  (dolist (map maps)
+    (bnd1 (ranges-next)
+      (doseq ((start length) ranges)
+        (while (> length 0)
+          (bnd* (((source dest size) (or (find-range start map)
+                                         (unmapped-range start length)))
+                 (available (- size (- start source)))
+                 (mapped (if (< available length) available length)))
+            (push (list (+ (- start source) dest)
+                        mapped)
+                  ranges-next)
+            (setf start (+ start mapped) ; was doing (+ start mapped 1)
+                  length (- length mapped)))))
+      (setf ranges ranges-next)))
+  (reduce #'min ranges :key #'first))
+
+
+(define-solution (2023 05) (input parse-input)
+  (values (part1 input) (part2 input)))
 
-#+#:excluded (time (1- (reduce #'min (part2) :key #'first)))
-205409647 ;too high
-20191103 ; this is what my solution outputs... however, it's off by 1...
-         ; i noticed it was off by one with the example... so I gave it a shot
-         ; anyways, and it worked... go figure..
+(define-test (2023 05) (600279879 20191102))