Day 15. Also, some code cleanup:

- Modified IntCode interpreter to be entirely functional (via functional
vector-set!*) and fixed a bug
- Removed `zip` since it can be implemented as map
- Reimplemented `transpose` more idiomatically
- Added functions for creating, converting, displaying grids stored in
vector, list, and hashtable forms

input/15.txt

@@ -0,0 +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,1002,1034,1,1039,101,0,1036,1041,1001,1035,-1,1040,1008,1038,0,1043,102,-1,1043,1032,1,1037,1032,1042,1106,0,124,101,0,1034,1039,101,0,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,1001,1038,0,1043,1001,1037,0,1042,1106,0,124,1001,1034,1,1039,1008,1036,0,1041,1002,1035,1,1040,1002,1038,1,1043,101,0,1037,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,1102,2,1,1044,1105,1,224,2,1041,1043,1032,1006,1032,179,1101,1,0,1044,1105,1,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,58,1044,1106,0,224,1101,0,0,1044,1106,0,224,1006,1044,247,101,0,1039,1034,101,0,1040,1035,1001,1041,0,1036,1001,1043,0,1038,1001,1042,0,1037,4,1044,1105,1,0,33,14,68,54,69,24,9,59,2,7,68,23,97,53,74,21,32,37,55,83,3,26,85,52,38,10,81,19,82,47,70,27,60,32,98,40,46,75,17,66,11,92,30,84,90,36,71,6,82,95,45,23,75,49,38,71,72,2,72,26,64,93,53,68,90,42,3,64,3,66,21,84,47,15,87,60,18,96,30,14,54,99,48,12,63,62,86,41,56,79,50,99,38,68,16,15,69,53,90,59,28,41,7,94,47,74,68,56,43,70,22,55,72,87,28,50,28,55,98,97,22,64,63,21,28,8,87,91,39,1,93,52,95,96,68,13,24,64,14,65,78,89,34,85,92,35,57,83,70,21,75,43,24,76,74,11,90,55,74,22,63,9,95,64,79,2,78,30,74,75,33,23,47,93,93,56,77,48,72,35,42,82,36,25,20,81,15,56,95,96,33,94,53,46,64,31,46,98,43,40,98,48,6,71,44,83,7,56,64,92,72,24,29,35,37,22,63,21,28,68,75,31,77,28,96,71,35,11,66,55,87,17,64,5,53,95,79,52,95,16,78,80,47,51,90,68,63,1,10,99,79,80,30,97,32,82,27,62,49,1,61,93,71,7,39,93,40,75,50,94,68,22,3,44,5,93,55,53,92,92,16,30,94,17,15,77,55,76,25,97,53,73,96,54,98,39,73,75,5,56,78,81,48,64,73,97,25,71,91,28,56,90,53,75,28,79,63,35,48,81,8,28,95,73,52,30,29,88,4,94,2,36,92,86,87,9,34,92,98,30,99,40,37,87,36,49,34,99,72,38,54,71,1,74,41,20,72,40,90,89,6,1,74,50,63,47,98,79,45,90,78,34,10,78,2,72,94,56,30,86,45,82,74,51,73,88,36,65,30,63,8,17,68,92,13,93,3,77,72,20,90,63,37,86,77,17,95,56,57,61,77,74,19,18,70,34,93,23,96,8,93,1,79,81,66,27,38,2,12,31,81,43,48,93,67,60,17,93,44,99,39,72,35,92,99,42,46,79,60,22,56,75,60,95,23,84,33,67,16,16,36,55,39,83,46,75,80,79,2,63,25,60,20,4,39,97,20,90,4,30,86,9,7,90,80,49,20,98,29,83,51,46,92,27,65,34,57,61,10,94,84,90,3,51,64,5,37,19,51,69,73,39,96,99,24,34,66,21,76,81,33,85,14,67,54,29,94,17,85,8,88,42,6,89,83,9,52,81,90,11,38,95,20,93,81,20,20,86,6,36,69,77,25,15,91,78,32,80,3,22,11,90,89,6,11,73,1,82,46,77,99,26,41,2,75,92,52,13,80,96,44,38,98,47,96,87,28,65,77,17,48,93,93,46,8,82,86,26,84,64,38,53,83,67,97,30,64,39,53,31,63,60,11,86,81,22,84,13,89,75,2,77,5,31,69,3,8,75,60,13,14,90,66,28,66,18,85,70,51,82,94,28,29,99,35,71,75,80,1,93,14,13,91,14,83,24,77,32,8,48,85,96,31,6,54,70,95,32,35,66,80,88,3,96,35,80,54,8,70,30,2,18,59,81,27,31,85,73,35,79,68,30,14,21,67,74,57,60,98,44,46,24,12,60,31,39,68,79,50,3,61,40,75,54,25,85,6,93,56,86,74,98,10,15,66,68,13,44,26,98,40,79,80,14,14,86,30,5,74,66,46,96,17,83,6,98,16,67,91,90,56,97,1,68,14,85,93,69,56,88,40,79,29,91,25,68,69,74,48,66,73,76,17,61,31,62,90,84,46,89,0,0,21,21,1,10,1,0,0,0,0,0,0

lib.rkt

@@ -9,22 +9,31 @@
 
 (provide problem-input
          show-solution
-         show-msg
+
+         make-vector-grid
+         vectors->lists
+         hash->vector
+         show-list-grid
+         show-vector-grid
+         show-hash-grid
+
          ∘ ∂ $
          uncurry
+
          sum
-         neq?
+         != neq?
          nzero?
          negate
          pos-or-zero
-         number->digits-reverse
          number->digits
+         number->digits-reverse
+
          rac
          list-ref*
          chunks-of
          transpose
-         zip
          list->queue
+
          vector-ref*
          vector-set!*)
 
@@ -53,15 +62,55 @@
 (define (show-solution part1 part2)
   (printf "Part 1: ~a\nPart 2: ~a\n" part1 part2))
 
-;; show-msg : (hashof (a => char)) -> (listof (listof a)) -> void
+
-;; Given a grid of values, show the grid line by line,
+;; Grid helpers ;;
-;; with values replaced by characters in the given hash.
+;; A grid of values might be stored in three different ways:
-(define (show-msg char-hash msg)
+;; - As a hashtable from positions (number . number) to values; or
+;; - As a vector of vectors of values; or
+;; - As a list of lists of values.
+
+;; make-vector-grid : number -> number -> number -> vector-grid
+(define (make-vector-grid width height [default 0])
+  (build-vector height (λ (_) (make-vector width default))))
+
+;; vectors->lists : vector-grid -> list-grid
+(define (vectors->lists vector-grid)
+  (map vector->list (vector->list vector-grid)))
+
+;; hash->vector : hash-grid -> number -> vector-grid
+;; Where the position is not in the hash-grid,
+;; the vector-grid takes on the default value.
+(define (hash->vector hash-grid [default 0])
+  (let* ([keys (hash-keys hash-grid)]
+         [xs (map car keys)]
+         [ys (map cdr keys)]
+         [min-x (apply min xs)]
+         [min-y (apply min ys)]
+         [width  (add1 (- (apply max xs) min-x))]
+         [height (add1 (- (apply max ys) min-y))]
+         [vector-grid (make-vector-grid width height default)])
+    (hash-for-each
+     hash-grid (λ (pos val)
+            (let ([x (- (car pos) min-x)]
+                  [y (- (cdr pos) min-y)])
+              (vector-set! (vector-ref vector-grid y) x val))))
+    vector-grid))
+
+;; show-list-grid : (hashof (value => char)) -> list-grid -> void
+(define (show-list-grid char-hash list-grid)
   (for-each
    displayln
    (map (∘ list->string
            (∂ map (∂ hash-ref char-hash)))
-        msg)))
+        list-grid)))
+
+;; show-vector-grid : (hashof (value => char)) -> vector-grid -> void
+(define (show-vector-grid char-hash vector-grid)
+  (show-list-grid char-hash (vectors->lists vector-grid)))
+
+;; show-hash-grid : (hashof (value => char)) -> hash-grid -> number -> void
+(define (show-hash-grid char-hash hash-grid [default 0])
+  (show-vector-grid char-hash (hash->vector hash-grid default)))
 
 
 ;; Number helpers ;;
@@ -69,6 +118,10 @@
 ;; sum : (listof number) -> number
 (define (sum ns) (apply + ns))
 
+;; != : number -> number -> boolean
+(define (!= n1 n2)
+  (not (= n1 n2)))
+
 ;; neq : any -> any -> boolean
 (define (neq? v1 v2)
   (not (eq? v1 v2)))
@@ -131,21 +184,14 @@
 ;; e.g. '((1 2 3 4)          '((1 5 8)
 ;;        (5 6 7)         =>   (2 6 9)
 ;;        (8 9 10 11 12))      (3 7 10))
-(define (transpose layers)
+(define (transpose lists)
-  (if (ormap empty? layers) '()
+  (apply map list lists))
-      (let ([pixels (map car layers)]
-            [layers (map cdr layers)])
-        (cons pixels (transpose layers)))))
-
-;; zip : (a1 -> ... -> an -> b) -> (listof a1) -> ... -> (listof an) -> (listof b)
-(define (zip f . lsts)
-  (map (curry apply f) (transpose lsts)))
 
 ;; list->queue : (listof any) -> (queueof any)
 ;; Creates a queue and adds elements of list in order
 (define (list->queue lst)
   (let ([Q (make-queue)])
-    (for-each (curry enqueue! Q) lst)
+    (for-each (∂ enqueue! Q) lst)
     Q))
 
 
@@ -160,14 +206,12 @@
       (vector-ref vec pos)))
 
 ;; vector-set!* : (vectorof any) -> number -> any -> (vectorof any)
-;; Set the value at given index in the vector, then return the vector
+;; Set the value at given index in a new vector, then return that vector
 ;; If the index is beyond the length of the vector,
 ;; a vector that can accomodate that index is returned,
 ;; with all the original elements and the element at the index set
 (define (vector-set!* vec pos v)
-  (if (< pos (vector-length vec))
+  (let ([new-vec (make-vector (max (vector-length vec) (add1 pos)))])
-      (begin (vector-set! vec pos v) vec)
-      (let ([new-vec (make-vector (add1 pos))])
         (vector-copy! new-vec 0 vec)
         (vector-set! new-vec pos v)
-        new-vec)))
+        new-vec))

src/08.rkt

@@ -26,6 +26,6 @@
 
 (define part2
   (let* ([image (map (∂ findf (∂ neq? #\2)) (transpose layers))])
-    (show-msg pixel-hash (chunks-of image width))))
+    (show-list-grid pixel-hash (chunks-of image width))))
 
 (show-solution part1 #f)

src/10.rkt

@@ -59,9 +59,9 @@
     (< θ1 θ2)))
 
 (define part2
-  (let* ([offsets (map (λ (ast) (zip - ast location)) in-view)]
+  (let* ([offsets (map (λ (ast) (map - ast location)) in-view)]
          [offsets (sort offsets offset<?)]
-         [200th (zip + location (list-ref offsets (sub1 200)))])
+         [200th (map + location (list-ref offsets (sub1 200)))])
     (+ (* (first 200th) 100) (second 200th))))
 
 (show-solution part1 part2)

src/11.rkt

@@ -67,19 +67,6 @@
 (define (part2)
   (set! hull (make-hash '(((0 . 0) . 1))))
   (deploy (exec input) 'U '(0 . 0))
-  (let* ([positions (hash-keys hull)]
+  (show-hash-grid panel-hash hull) #f)
-         [xs (map car positions)]
-         [ys (map cdr positions)]
-         [xmin (apply min xs)]  [xmax (apply max xs)]
-         [ymin (apply min ys)]  [ymax (apply max ys)]
-         [xrange (- xmax xmin)] [yrange (- ymax ymin)]
-         [grid (make-grid xrange yrange)])
-    (hash-for-each
-     hull
-     (λ (xy c)
-       (let* ([x (- (car xy) xmin)]
-              [y (- (cdr xy) ymin)])
-         (vector-set! (vector-ref grid y) x c))))
-    (show-msg panel-hash (map vector->list (vector->list grid)))))
 
 (show-solution (part1) (part2))

src/12.rkt

@@ -38,7 +38,7 @@
 ;; Step moon trajectories once
 (define (step-1D moons vels)
   (let* ([vels (velocities-1D moons vels)]
-         [moons (zip + moons vels)])
+         [moons (map + moons vels)])
     (values moons vels)))
 
 ;; step-n-1D : number -> (listof pos) -> (listof vel) -> (values (listof pos) (listof vel))

src/13.rkt

@@ -1,6 +1,7 @@
 #lang plai
 
-(require "../lib.rkt"
+(require racket/vector
+         "../lib.rkt"
          "IntCode.rkt")
 
 (define input
@@ -42,7 +43,7 @@
 
 (define (draw-grid)
   (printf "Score: ~a\n" score)
-  (show-msg tile-hash (take (map vector->list (vector->list grid)) 26)))
+  (show-vector-grid tile-hash (vector-take grid 26)))
 
 (define (update-grid! x y t)
   (cond

src/15.rkt

@@ -0,0 +1,100 @@
+#lang plai
+
+(require graph
+         data/queue
+         (except-in "../lib.rkt" transpose)
+         "IntCode.rkt")
+
+(define input
+  (string->program (car (problem-input 15))))
+
+;; grid : (hashof (coord => status))
+;; We will use a hashtable from coordinates to status codes:
+;; 0: wall
+;; 1: floor
+;; 2: oxygen system
+;; 3: unexplored
+;; 4: droid
+;; Use (show-hash-grid status-hash grid 3) to print out the grid as a map
+(define status-hash (make-hash '((0 . #\#) (1 . #\.) (2 . #\O) (3 . #\ ) (4 . #\D))))
+
+;; coord : (number . number)
+;; Coordinates increase in the southern and eastern directions
+
+;; next-doors : dir -> coord -> (listof coord)
+;; Give a list of the next coordinates we could visit
+(define (next-coords coord)
+  (let* ([x (car coord)]
+         [y (cdr coord)])
+    (list (cons x (sub1 y))
+          (cons x (add1 y))
+          (cons (sub1 x) y)
+          (cons (add1 x) y))))
+
+;; next-dir : coord -> coord -> dir
+;; Given our old coordinate and the new coordinate,
+;; return the direction we have gone in
+(define (next-dir old-coord new-coord)
+  (let ([old-x (car old-coord)]
+        [old-y (cdr old-coord)]
+        [new-x (car new-coord)]
+        [new-y (cdr new-coord)])
+    (cond
+      [(< new-y old-y) 1]    ; north
+      [(> new-y old-y) 2]    ; south
+      [(< new-x old-x) 3]    ; west
+      [(> new-x old-x) 4]))) ; east
+
+;; move-list : coord -> state -> grid -> (list grid (listof procedure))
+;; For each possible direction we can move in, return an update grid
+;; and a list of functions, each of which are advancing the state
+;; from the next possible coordinate when given a grid
+;; I'm not sure how to assign a type to this...
+(define (move-list coord st grid)
+  (let ([unvisited (filter-not (∂ hash-has-key? grid) (next-coords coord))])
+    (foldl
+     (λ (next grid-lst)
+       (match-let ([(list grid lst) grid-lst])
+         (type-case state (resume-with-input st (next-dir coord next))
+           [out (value resume)
+                (list (hash-set grid next value)
+                      (if (= 0 value) lst
+                          (cons (∂ move-list next (resume)) lst)))]
+           [else (error "Unexpected program state")])))
+     (list grid '()) unvisited)))
+
+;; explore-map : grid -> grid
+;; Breadth-first search of all accessible locations
+(define (explore-map grid)
+  (let ([Q (make-queue)])
+    (enqueue! Q (∂ move-list '(0 . 0) (exec input)))
+    (let loop ([grid grid])
+      (if (queue-empty? Q) grid
+          (match-let ([(list grid nexts)
+                       ((dequeue! Q) grid)])
+            (for-each (∂ enqueue! Q) nexts)
+            (loop grid))))))
+
+;; grid->graph : grid -> unweighted, undirected graph between coordinates
+;; There is an edge between coordinates if we can travel from one to the other
+(define (grid->graph grid)
+  (define (filter-non-wall coords)
+    (filter (λ (c) (!= 0 (hash-ref grid c 0))) coords))
+  (unweighted-graph/undirected
+   (apply append
+          (map (λ (coord)
+                 (map (∂ list coord)
+                      (filter-non-wall (next-coords coord))))
+               (filter-non-wall (hash-keys grid))))))
+
+(define-values (part1 part2)
+  (let* ([grid (make-immutable-hash '(((0 . 0) . 4)))]
+         [grid (explore-map grid)]
+         [oxygen (car (findf (∘ (∂ = 2) cdr) (hash->list grid)))]
+         [graph (grid->graph grid)])
+    (show-hash-grid status-hash grid 3)
+    (let-values ([(dist-hash _) (dijkstra graph oxygen)])
+      (values (hash-ref dist-hash '(0 . 0))
+              (apply max (hash-values dist-hash))))))
+
+(show-solution part1 part2)

src/IntCode.rkt

@@ -3,7 +3,7 @@
 (require racket/vector
          "../lib.rkt")
 
-(define (vector-ref** vec pos)
+(define (vector-ref vec pos)
   (vector-ref* vec pos 0))
 
 ;; string->program : string -> (listof number)
@@ -74,7 +74,7 @@
 ;; If the mode is 2, the value at pointer is an address to be offset by base.
 ;; Note that leading zeroes in the encoded instruction are omitted.
 (define (exec* program #:ptr [pointer 0] #:base [base 0])
-  (define instruction (vector-ref** program pointer))
+  (define instruction (vector-ref program pointer))
   (define opcode (remainder instruction 100))
   (define next-pointer
     (match opcode
@@ -84,9 +84,9 @@
       [99 (+ pointer 1)]))
   (define (get-location index mode)
     (match mode
-      [0 (vector-ref** program (+ pointer index))]
+      [0 (vector-ref program (+ pointer index))]
       [1 (+ pointer index)]
-      [2 (+ (vector-ref** program (+ pointer index)) base)]))
+      [2 (+ (vector-ref program (+ pointer index)) base)]))
   (let* ([mode1 (remainder (quotient instruction 100) 10)]
          [mode2 (remainder (quotient instruction 1000) 10)]
          [mode3 (remainder (quotient instruction 10000) 10)]
@@ -95,9 +95,9 @@
          [l2 (λ () (get-location 2 mode2))]
          [l3 (λ () (get-location 3 mode3))]
          ;; v* : call to read values from program
-         [v1 (λ () (vector-ref** program (l1)))]
+         [v1 (λ () (vector-ref program (l1)))]
-         [v2 (λ () (vector-ref** program (l2)))]
+         [v2 (λ () (vector-ref program (l2)))]
-         [v3 (λ () (vector-ref** program (l3)))])
+         [v3 (λ () (vector-ref program (l3)))])
     (match opcode
       [(or 1 2)
        (let* ([arith (match opcode [1 +] [2 *])]
@@ -107,8 +107,8 @@
       [3
        (let* ([resume
                (λ (input)
-                 (vector-set!* program (l1) input)
+                 (let ([program (vector-set!* program (l1) input)])
-                 (exec* program #:ptr next-pointer #:base base))])
+                   (exec* program #:ptr next-pointer #:base base)))])
          (in resume))]
       [4
        (let* ([output (v1)]