AOC 2023 0x21A9

Content/20231201110623-advent_of_code.org

@@ -458,3 +458,136 @@
 		   (return))
 		 (incf (aref freqs i) id-copies)))))))
 #+end_src
+
+* --- Day 5: If You Give A Seed A Fertilizer ---
+ - https://adventofcode.com/2023/day/5
+
+#+begin_src lisp
+(load "~/quicklisp/setup.lisp")
+(ql:quickload :cl-ppcre)
+
+(defmacro ssq (str sequence)
+  `(cl-ppcre:split ,str ,sequence))
+
+(defun read-and-parse-file (file-name)
+  (with-open-file (stream file-name)
+    (ssq (coerce '(#\Return #\Return) 'string)
+	 (apply #'concatenate 'string
+		(loop for line = (read-line stream nil)
+		      while line
+		      collect line)))))
+
+(defvar *from-chain* '(seed soil fertilizer water light temperature humidity))
+
+(defparameter *lambda-hash* (make-hash-table))
+
+(defun smap (map-line)
+  (let* ((spec (ssq " " map-line))
+	 (sst (read-from-string (second spec)))
+	 (dst (read-from-string (first spec)))
+	 (rl (read-from-string (third spec))))
+    #'(lambda (smap-request)
+	(if (<= sst smap-request (+ sst rl -1))
+	    (+ dst (- smap-request sst))
+	    nil))))
+
+(defun compile-smaps (smap-list)
+  (let ((smappers smap-list))
+    #'(lambda (map-request)
+	(dolist (smapper smappers map-request)
+	  (let ((smapped (funcall smapper map-request)))
+	    (if smapped
+		(return smapped)))))))
+
+(defun build-map (from to mapper)
+  (labels ((fetch-from () from)
+	   (fetch-to () to)
+	   (call (input) (funcall mapper input)))
+    #'(lambda (message &optional input)
+	(cond ((eq message 'from) (fetch-from))
+	      ((eq message 'to) (fetch-to))
+	      ((eq message 'call) (call input))
+	      (t (error "invalid message received"))))))
+
+(defun parse-map-spec (map-spec)
+  (let* ((title (car (ssq " " map-spec)))
+	 (a (read-from-string (car (ssq "-to-" title))))
+	 (b (read-from-string (cadr (ssq "-to-" title))))
+	 (smaps (mapcar #'smap (cdr (ssq #\Return map-spec)))))
+    (build-map a b (compile-smaps smaps))))
+
+(defun range (start len)
+  (loop for i from start below (+ start len) 
+	collect i))
+
+(defun parse-seed-spec (seed-spec)
+  (do* ((key-head seed-spec (cdr value-head))
+	(value-head (cdr key-head) (cdr key-head))
+	(seeds '() ))
+       ((null key-head) seeds)
+    (setf seeds (append (range (car key-head) (car value-head))
+			seeds) )))
+
+(defun parse-spec-brute (file-name)
+  (let* ((info (read-and-parse-file file-name))
+	 (seeds (parse-seed-spec
+		 (mapcar #'read-from-string
+			 (ssq " " (cadr (ssq ": " (car info)))))))
+	 (maps (mapcar #'parse-map-spec (cdr info))))
+    (dolist (map maps)
+      (setf (gethash (funcall map 'from) *lambda-hash*) map))
+    seeds))
+
+(defun soil-to-loc (soil-number)
+  (let ((mappers (mapcar #'(lambda (from-sym)
+			     (gethash from-sym *lambda-hash*))
+			 *from-chain*))
+	(passed soil-number))
+    (loop for func in mappers
+	  do (setf passed (funcall func 'call passed)))
+    passed))
+
+(defun solve-brute (file-name)
+  (clrhash *lambda-hash*)
+  (apply #'min (mapcar #'soil-to-loc
+		       (parse-spec-brute file-name))))
+
+;; Optimization 1
+;; report min soil number for a range
+;; final report min of mins
+;; do not build seed-range list on the get go
+
+(defun parse-seed-spec-opt-1 (seed-spec)
+  (do* ((key-head seed-spec (cdr value-head))
+	(value-head (cdr key-head) (cdr key-head))
+	(seeds '()))
+       ((null key-head) (reverse seeds))
+    (setf seeds (cons  (cons (car key-head)
+			     (car value-head))
+		       seeds))))
+
+(defun parse-spec-opt-1 (file-name)
+  (let* ((info (read-and-parse-file file-name))
+	 (seed-ranges (parse-seed-spec-opt-1
+		       (mapcar #'read-from-string
+			       (ssq " " (cadr (ssq ": " (car info)))))))
+	 (maps (mapcar #'parse-map-spec (cdr info))))
+    (dolist (map maps)
+      (setf (gethash (funcall map 'from) *lambda-hash*) map))
+    seed-ranges))
+
+(defun min-range-soil-to-loc (range-info)
+  (let* ((start (car range-info))
+	 (len (cdr range-info))
+	 (local-min (apply #'min (mapcar #'soil-to-loc (range start len)))))
+    (format t "~%local-min for ~S : ~S" range-info local-min)
+    (force-output)
+    local-min))
+
+(defun solve-opt-1 (file-name)
+  (clrhash *lambda-hash*)
+  (let ((seed-ranges (parse-spec-opt-1 file-name)))
+    (format t "~%final min: ~S"
+	    (apply #'min (mapcar #'min-range-soil-to-loc
+			 seed-ranges)))))
+#+end_src