f524273415d0

2019/15
[view raw] [browse files]
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