day-5.lisp (2857B)
1 (defpackage #:aoc/day-5 2 (:use #:cl #:aoc/utils) 3 (:export #:day-5)) 4 (in-package #:aoc/day-5) 5 6 (defun parse-seeds (input) 7 (let ((line (prog1 8 (read-line input) 9 (read-line input)))) 10 (read-number-list line :start (1+ (position #\: line))))) 11 12 (defun parse-maps (input) 13 (loop for header = (read-line input nil) 14 while header 15 collect (sort (loop for line = (read-line input nil) 16 while (and line (string/= line "")) 17 collect (read-number-list line)) 18 (lambda (a b) 19 (< (second a) (second b)))))) 20 21 (declaim (ftype (function (fixnum list) fixnum) map-number)) 22 (defun map-number (number map) 23 (or (loop for (dest source length) (fixnum fixnum fixnum) in map 24 for diff fixnum = (- number source) 25 when (and (>= diff 0) 26 (< diff length)) 27 do (return (the fixnum (+ dest diff)))) 28 number)) 29 30 (defun map-seed (seed maps) 31 (loop with n = seed 32 for map in maps 33 do (setf n (map-number n map)) 34 finally (return n))) 35 36 (defun split-range (range map) 37 (declare (optimize speed)) 38 (destructuring-bind (start range-length) 39 range 40 (declare (type fixnum start range-length)) 41 (loop with range-end fixnum = (+ start range-length -1) 42 for (dest source length) (fixnum fixnum fixnum) in map 43 while (<= source range-end) 44 for end-map fixnum = (+ source length -1) 45 when (< start source) 46 collect (list start (the fixnum (- source start))) into split-ranges 47 and do (setf start source) 48 do (decf length (+ (- start source))) 49 do (decf length (max (- (the fixnum (+ start length -1)) 50 range-end) 51 0)) 52 when (>= end-map start) 53 collect (list (the fixnum (+ dest (- start source))) length) into split-ranges 54 and do (incf start length) 55 finally (return (if (< start range-end) 56 (cons (list start (the fixnum (- range-end start -1))) 57 split-ranges) 58 split-ranges))))) 59 60 (defun split-ranges (ranges map) 61 (loop for range in ranges 62 nconc (split-range range map))) 63 64 (defun task-2 (ranges maps) 65 (dolist (map maps) 66 (setf ranges (split-ranges ranges map))) 67 (loop for range in ranges 68 minimize (car range) fixnum)) 69 70 (defun day-5 (input) 71 (let* ((seeds (parse-seeds input)) 72 (maps (parse-maps input))) 73 (values 74 (loop for seed in seeds 75 minimize (map-seed seed maps) fixnum) 76 (task-2 (loop for (seed-start seed-length) on seeds by #'cddr 77 collect (list seed-start seed-length)) 78 maps))))