f524273415d0
2019/15
author | Steve Losh <steve@stevelosh.com> |
---|---|
date | Sun, 15 Dec 2019 13:14:04 -0500 |
parents | 81b47667837b |
children | 182bdd87fd9e |
branches/tags | (none) |
files | data/2019/15.txt package.lisp src/2019/days/day-03.lisp src/2019/days/day-12.lisp src/2019/days/day-13.lisp src/2019/days/day-15.lisp src/utils.lisp |
Changes
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/data/2019/15.txt Sun Dec 15 13:14:04 2019 -0500 @@ -0,0 +1,1 @@ +3,1033,1008,1033,1,1032,1005,1032,31,1008,1033,2,1032,1005,1032,58,1008,1033,3,1032,1005,1032,81,1008,1033,4,1032,1005,1032,104,99,102,1,1034,1039,1002,1036,1,1041,1001,1035,-1,1040,1008,1038,0,1043,102,-1,1043,1032,1,1037,1032,1042,1106,0,124,1002,1034,1,1039,102,1,1036,1041,1001,1035,1,1040,1008,1038,0,1043,1,1037,1038,1042,1105,1,124,1001,1034,-1,1039,1008,1036,0,1041,102,1,1035,1040,102,1,1038,1043,1002,1037,1,1042,1105,1,124,1001,1034,1,1039,1008,1036,0,1041,102,1,1035,1040,102,1,1038,1043,1002,1037,1,1042,1006,1039,217,1006,1040,217,1008,1039,40,1032,1005,1032,217,1008,1040,40,1032,1005,1032,217,1008,1039,33,1032,1006,1032,165,1008,1040,35,1032,1006,1032,165,1101,2,0,1044,1106,0,224,2,1041,1043,1032,1006,1032,179,1101,1,0,1044,1106,0,224,1,1041,1043,1032,1006,1032,217,1,1042,1043,1032,1001,1032,-1,1032,1002,1032,39,1032,1,1032,1039,1032,101,-1,1032,1032,101,252,1032,211,1007,0,37,1044,1105,1,224,1102,0,1,1044,1105,1,224,1006,1044,247,101,0,1039,1034,101,0,1040,1035,102,1,1041,1036,1001,1043,0,1038,1002,1042,1,1037,4,1044,1105,1,0,31,10,7,30,32,67,8,24,11,62,6,11,19,78,16,20,8,80,14,19,63,8,40,36,65,34,59,23,33,29,79,19,47,28,54,8,11,41,33,57,85,25,56,48,16,90,74,39,11,79,68,18,46,33,74,47,25,60,1,23,78,69,5,55,12,28,73,22,80,30,26,55,2,6,96,21,57,34,33,10,91,72,61,31,2,24,29,94,24,12,43,60,72,79,27,24,21,95,59,15,53,34,9,36,82,83,4,67,30,62,5,70,94,1,81,75,6,18,68,9,26,38,31,1,98,57,97,63,8,60,35,5,48,36,59,75,4,88,23,21,39,10,99,13,36,53,66,73,28,33,80,28,78,23,7,30,27,77,28,69,69,1,65,78,17,17,2,16,27,91,43,27,72,93,6,5,92,12,55,79,94,98,60,19,15,36,35,55,9,62,84,27,74,56,25,9,60,72,15,34,59,15,31,58,76,24,81,62,99,35,31,14,39,25,60,3,5,46,24,48,22,1,73,99,96,27,46,48,5,65,26,6,48,11,13,69,12,33,22,95,11,72,28,42,28,88,5,31,56,50,72,30,49,84,52,32,11,45,7,54,60,12,72,33,38,62,18,54,31,8,92,53,34,4,76,21,46,81,53,81,21,10,63,12,75,22,62,87,32,23,30,40,29,24,61,6,88,70,14,18,99,13,14,4,72,5,22,54,90,75,35,1,10,49,17,7,98,8,81,13,47,59,13,80,70,9,26,73,22,77,3,22,73,99,74,11,10,60,4,27,86,46,67,30,94,29,93,26,66,25,8,14,92,24,45,78,24,23,97,31,9,25,25,61,44,35,31,73,52,80,35,96,32,43,8,66,57,87,31,85,12,50,74,7,23,61,12,7,78,1,1,53,14,54,18,18,63,41,25,90,1,85,24,22,98,62,35,14,19,50,80,20,7,73,21,14,81,19,89,11,31,84,7,53,9,54,20,90,72,31,70,54,17,31,59,18,8,69,83,58,78,12,98,20,81,26,50,95,19,25,54,31,80,67,6,3,87,6,99,93,22,75,73,34,52,58,22,32,52,34,30,85,54,58,75,14,22,97,12,36,53,67,32,99,54,15,4,66,69,7,48,87,25,17,41,57,10,63,35,24,43,5,57,25,93,22,71,7,36,63,84,26,4,7,78,26,68,77,35,9,70,17,12,59,41,78,18,54,18,80,18,86,93,19,35,73,34,53,97,23,2,95,30,32,85,21,21,79,19,18,85,57,23,85,35,34,61,30,66,29,19,76,30,17,46,1,16,98,26,25,91,15,47,54,75,26,17,36,74,60,33,28,49,53,15,13,45,6,90,26,73,17,87,4,68,18,30,22,96,92,97,14,40,24,50,96,15,49,55,79,8,16,1,50,5,60,55,14,41,67,25,26,71,18,26,89,70,14,6,51,11,94,68,69,22,73,63,6,33,88,36,51,20,6,44,26,71,17,31,11,86,81,23,31,80,18,87,26,12,91,8,41,6,18,9,33,90,1,59,56,32,29,54,50,34,12,74,97,10,39,87,41,9,52,67,21,22,38,61,57,1,87,4,35,98,61,16,95,78,65,17,31,9,71,9,52,52,9,8,73,40,36,16,48,52,9,26,39,4,17,42,1,35,80,93,4,40,23,13,66,7,28,84,73,22,31,76,31,21,39,4,83,84,41,27,66,34,88,15,50,65,45,22,65,26,78,15,50,40,79,31,38,9,60,2,51,24,46,99,42,27,45,1,71,20,78,86,95,9,81,0,0,21,21,1,10,1,0,0,0,0,0,0
--- a/package.lisp Sat Dec 14 20:00:14 2019 -0500 +++ b/package.lisp Sun Dec 15 13:14:04 2019 -0500 @@ -80,6 +80,12 @@ :bisect-integers-left :bisect-integers-right + :print-hash-table-map + + :clear + :green + :reset + )) (eval-when (:compile-toplevel :load-toplevel :execute)
--- a/src/2019/days/day-03.lisp Sat Dec 14 20:00:14 2019 -0500 +++ b/src/2019/days/day-03.lisp Sun Dec 15 13:14:04 2019 -0500 @@ -1,16 +1,6 @@ (defpackage :advent/2019/03 #.cl-user::*advent-use*) (in-package :advent/2019/03) -(defun print-grid (grid) - (multiple-value-bind (left right bottom top) - (bounds (alexandria:hash-table-keys grid)) - (iterate - (for y :from (1+ top) :downto (1- bottom)) - (iterate - (for x :from (1- left) :to (1+ right)) - (princ (gethash (complex x y) grid #\.))) - (terpri)))) - (defun parse-path (string) (iterate (for ((#'first-character direction) (#'parse-integer distance)) @@ -62,11 +52,15 @@ (flet ((intersection-cost (point) (+ (gethash point scores1) (gethash point scores2)))) + ;; (print-hash-table-map grid :default #\. :pad 1) (values (alexandria:extremum (mapcar #'manhattan-distance intersections) #'<) (alexandria:extremum (mapcar #'intersection-cost intersections) #'<))))) -;; (run '("R8,U5,L5,D3" "U7,R6,D4,L4")) +#; Scratch -------------------------------------------------------------------- + +(run '("R8,U5,L5,D3" "U7,R6,D4,L4")) + ;; (run '( ;; "R75,D30,R83,U83,L12,D49,R71,U7,L72" ;; "U62,R66,U55,R34,D71,R55,D58,R83"
--- a/src/2019/days/day-12.lisp Sat Dec 14 20:00:14 2019 -0500 +++ b/src/2019/days/day-12.lisp Sun Dec 15 13:14:04 2019 -0500 @@ -1,4 +1,4 @@ -(defpackage :advent/2019/12 #.cl-user::*advent-use*) +(advent:defpackage* :advent/2019/12) (in-package :advent/2019/12) (defclass* moon () (pos vel))
--- a/src/2019/days/day-13.lisp Sat Dec 14 20:00:14 2019 -0500 +++ b/src/2019/days/day-13.lisp Sun Dec 15 13:14:04 2019 -0500 @@ -39,31 +39,13 @@ :score score))))) (values screen score))) -(defun esc (string) - (format t "~C~A" #\esc string) - (force-output)) - -(defun clear () - (esc "[2J") - (esc "[;H")) - -(defun green () - (esc "[32m")) - -(defun reset () - (esc "[0m")) (defun draw-screen (update) (clear) (green) (format t "SCORE: ~D~%" (score update)) (reset) - (multiple-value-bind (left right bottom top) - (bounds (hash-table-keys (screen update))) - (do-irange ((row bottom top)) - (do-irange ((col left right)) - (write-char (tile-char (gethash (complex col row) (screen update))))) - (terpri)))) + (print-hash-table-map (screen update) :key #'tile-char :default nil :flip-y t)) (defun play-interactively (program) (setf (elt program 0) 2) @@ -100,3 +82,4 @@ #; Scratch -------------------------------------------------------------------- (play-interactively *data*) +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/2019/days/day-15.lisp Sun Dec 15 13:14:04 2019 -0500 @@ -0,0 +1,134 @@ +(advent:defpackage* :advent/2019/15 (:shadow :step)) +(in-package :advent/2019/15) + +(defparameter *animate* nil) +(defparameter *directions* '(#c(0 1) #c(0 -1) #c(-1 0) #c(1 0))) + +(defclass* repair-machine () + ((machine) + (input) + (output) + (pos :initform 0) + (world :initform (make-hash-table)) + (oxygen-position))) + +(defmethod initialize-instance :after ((machine repair-machine) &key) + (setf (gethash 0 (world machine)) #\.)) + +(defun make-repair-machine (program) + (let ((input (make-queue)) + (output (make-queue))) + (make-instance 'repair-machine + :machine (advent/intcode:init program + :input (curry #'dequeue input) + :output (rcurry #'enqueue output)) + :input input + :output output))) + +(defun step (machine) + "Run `machine` until it produces some output." + (loop :while (queue-empty-p (output machine)) + :do (advent/intcode:step (machine machine)))) + +(defun print-world (machine) + (print-hash-table-map + (world machine) + :pad 1 + :get (lambda (pos) + (if (= (pos machine) pos) + #\@ + (gethash pos (world machine) #\space))))) + +(defun dir->int (dir) + (ecase dir + (#c( 0 1) 1) + (#c( 0 -1) 2) + (#c(-1 0) 3) + (#c( 1 0) 4))) + +(defun int->reply (int) + "Parse `int`, returning `(values result actually-moved found-oxygen)`." + (ecase int + (0 (values 'wall nil nil)) + (1 (values 'ok t nil)) + (2 (values 'oxygen t t)))) + +(defun result->char (reply) + (ecase reply + (wall #\#) + (ok #\.) + (oxygen #\O))) + +(defun move (machine direction) + (let ((target (+ (pos machine) direction))) + (enqueue (dir->int direction) (input machine)) + (step machine) + (multiple-value-bind (result actually-moved found-oxygen) + (int->reply (dequeue (output machine))) + (setf (gethash target (world machine)) + (result->char result)) + (when actually-moved + (setf (pos machine) target)) + (when found-oxygen + (setf (oxygen-position machine) target)) + actually-moved))) + +(defun explore (machine) + (labels ((seenp (pos) + (nth-value 1 (gethash pos (world machine)))) + (seen-direction-p (pos direction) + (seenp (+ pos direction))) + (unseen-directions (pos) + (remove-if (curry #'seen-direction-p pos) *directions*))) + (iterate + (with frontier = (list (unseen-directions 0))) + (with path = '()) + (when *animate* + (clear) + (print-world machine) + (sleep 1/60)) + (until (null frontier)) + (if (null (first frontier)) + (progn (pop frontier) ; backtrack + (when path (move machine (pop path)))) + (progn (for dir = (pop (first frontier))) + (when (move machine dir) + (push (unseen-directions (pos machine)) frontier) + (push (- dir) path))))))) + +(defun find-oxygen (machine) + (flet ((ref (pos) + (gethash pos (world machine)))) + (astar :start 0 + :neighbors (lambda (pos) + (remove #\# (manhattan-neighbors pos) :key #'ref)) + :goalp (lambda (pos) + (char= #\O (ref pos))) + :cost (constantly 1) + :heuristic (curry #'manhattan-distance (oxygen-position machine)) + :test #'eql))) + +(defun flood-oxygen (machine) + (labels ((ref (pos) + (gethash pos (world machine))) + (empty-neighbors (pos) + (remove #\. (manhattan-neighbors pos) :key #'ref :test-not #'char=)) + (oxygenate (pos) + (setf (gethash pos (world machine)) #\O))) + (iterate + (with frontier = (empty-neighbors (oxygen-position machine))) + (until (null frontier)) + (counting t) + (map nil #'oxygenate frontier) + (setf frontier (remove-duplicates (mapcan #'empty-neighbors frontier)))))) + +(define-problem (2019 15) (data read-numbers) (222 394) + (let ((machine (make-repair-machine data))) + (explore machine) + (values (1- (length (find-oxygen machine))) + (flood-oxygen machine)))) + +#; Scratch -------------------------------------------------------------------- + +(let ((*animate* t)) + (run))
--- a/src/utils.lisp Sat Dec 14 20:00:14 2019 -0500 +++ b/src/utils.lisp Sun Dec 15 13:14:04 2019 -0500 @@ -755,6 +755,55 @@ (recur low mid))))))) +(defun print-hash-table-map (table &key + flip-y + get + (pad 0) + (default #\space) + (key #'identity)) + "Print `table` to standard out. + + `table` must be a hash table with complex keys. `default` will be used as the + default value for the hash table. `key` will be called on the values before + printing (including `default`), and must return a character. + + If `get` is provided, it must be a function of one argument that will be + called on the keys instead of `(gethash ... table default)` to produce the + values. `key` will still be called on the result. + + The y-axis will be printed with higher values at the top, unless `flip-y` is + true. + + " + (multiple-value-bind (left right bottom top) + (bounds (alexandria:hash-table-keys table)) + (incf left (- pad)) + (incf right pad) + (incf bottom (- pad)) + (incf top pad) + (do-irange ((y (if flip-y bottom top) + (if flip-y top bottom))) + (do-irange ((x left right)) + (princ (funcall key (if get + (funcall get (complex x y)) + (gethash (complex x y) table default))))) + (terpri)))) + +(defun esc (string) + (format t "~C~A" #\esc string) + (force-output)) + +(defun clear () + (esc "[2J") + (esc "[;H")) + +(defun green () + (esc "[32m")) + +(defun reset () + (esc "[0m")) + + ;;;; A* Search ---------------------------------------------------------------- (defstruct path state