Day 24 refactoring

README.md

@@ -8,4 +8,4 @@ Approximate execution times of the hardest problems, compiled with `raco exe`.
 | 16  | 20.6     |
 | 19  | 75.7     |
 | 23  | 14.0     |
-| 24  | 747      |
+| 24  | 4.12     |

src/24.rkt

@@ -3,86 +3,70 @@
 (require "../lib.rkt"
          data/queue)
 
-(define test
-  (list "#.######"
-        "#>>.<^<#"
-        "#.<..<<#"
-        "#>v.><>#"
-        "#<^v^^>#"
-        "######.#"))
-
 (define input (problem-input 24))
 
-(define blizzards
+(define-values (xblizzards yblizzards)
-  (for/fold ([blizzards (make-immutable-hash)])
+  (for/fold ([xblizzards (make-immutable-hash)]
+             [yblizzards (make-immutable-hash)])
             ([row input]
              [y (in-naturals)])
-    (for/fold ([blizzards blizzards])
+    (for/fold ([xblizzards xblizzards]
+               [yblizzards yblizzards])
               ([col (string->list row)]
                [x (in-naturals)])
-      (if ((or/c #\> #\< #\^ #\v) col)
+      (define x* (sub1 x))
-          (hash-update blizzards `(,x ,y) #{cons col %} '())
+      (define y* (sub1 y))
-          blizzards))))
+      (match col
+        [(or #\< #\>)
+         (values xblizzards (hash-update yblizzards y* #{cons (list x* col) %} '()))]
+        [(or #\^ #\v)
+         (values (hash-update xblizzards x* #{cons (list y* col) %} '()) yblizzards)]
+        [else (values xblizzards yblizzards)]))))
 
 (define xmax (- (string-length (first input)) 2))
 (define ymax (- (length input) 2))
-(define start '(1 0))
+(define start '(0 -1))
-(define end `(,xmax ,(add1 ymax)))
+(define end `(,(sub1 xmax) ,ymax))
 
-(define (show blizzards)
+(define (blizzard? x y t)
-  (for ([y (in-inclusive-range 1 ymax)])
+  (or (for/or ([yb (hash-ref xblizzards x '())])
-    (for ([x (in-inclusive-range 1 xmax)])
+        (match yb
-      (display (first (hash-ref blizzards (list x y) '(#\.)))))
+          [`(,y* #\^) (= y (% (- y* t) ymax))]
-    (newline)))
+          [`(,y* #\v) (= y (% (+ y* t) ymax))]))
+      (for/or ([xb (hash-ref yblizzards y '())])
+        (match xb
+          [`(,x* #\<) (= x (% (- x* t) xmax))]
+          [`(,x* #\>) (= x (% (+ x* t) xmax))]))))
 
-(define (step blizzards)
+(define (clears x y t)
-  (for*/fold ([blizzards* (make-immutable-hash)])
+  (filter #{match-let ([(and `(,@xy ,t) `(,x ,y ,t)) %])
-             ([(xy bs) blizzards]
+             (or (and (<= 0 x) (< x xmax)
-              [b bs])
+                      (<= 0 y) (< y ymax)
-    (match (list xy b)
+                      (not (blizzard? x y t)))
-      [`((,x ,y) #\>)
-       (define x* (if (= x xmax) 1 (add1 x)))
-       (hash-update blizzards* `(,x* ,y) #{cons #\> %} '())]
-      [`((,x ,y) #\<)
-       (define x* (if (= x 1) xmax (sub1 x)))
-       (hash-update blizzards* `(,x* ,y) #{cons #\< %} '())]
-      [`((,x ,y) #\v)
-       (define y* (if (= y ymax) 1 (add1 y)))
-       (hash-update blizzards* `(,x ,y*) #{cons #\v %} '())]
-      [`((,x ,y) #\^)
-       (define y* (if (= y 1) ymax (sub1 y)))
-       (hash-update blizzards* `(,x ,y*) #{cons #\^ %} '())])))
-
-(define (clears blizzards x y)
-  (filter #{match-let ([(and xy `(,x ,y)) %])
-             (or (and (<= 1 x xmax)
-                      (<= 1 y ymax)
-                      (empty? (hash-ref blizzards xy '())))
                  (equal? xy start)
                  (equal? xy end))}
-          `((,x ,y)
+          `((,x ,y ,t)
-            (,(add1 x) ,y)
+            (,(add1 x) ,y ,t)
-            (,(sub1 x) ,y)
+            (,(sub1 x) ,y ,t)
-            (,x ,(add1 y))
+            (,x ,(add1 y) ,t)
-            (,x ,(sub1 y)))))
+            (,x ,(sub1 y) ,t))))
 
-(define (wayfind blizzards start end)
+(define (wayfind start end t)
   (define Q (make-queue))
-  (enqueue! Q `(,start ,0 ,blizzards))
+  (enqueue! Q `(,@start ,t))
   (let loop ([seen (set)])
     (match (dequeue! Q)
-      [`(,xy ,t ,blizzards) #:when (equal? xy end) (values blizzards t)]
+      [`(,@xy ,t) #:when (equal? xy end) t]
-      [`((,x ,y) ,t ,_) #:when (set-member? seen `(,x ,y ,t)) (loop seen)]
+      [xyt #:when (set-member? seen xyt) (loop seen)]
-      [`((,x ,y) ,t ,blizzards)
+      [(and xyt `(,x ,y ,t))
-       (define blizzards* (step blizzards))
+       (for ([clear (clears x y (add1 t))])
-       (for ([clear (clears blizzards* x y)])
+         (enqueue! Q clear))
-         (enqueue! Q `(,clear ,(add1 t) ,blizzards*)))
+       (loop (set-add seen xyt))])))
-       (loop (set-add seen `(,x ,y ,t)))])))
 
 (define-values (part1 part2)
-  (let*-values ([(blizzards t1) (wayfind blizzards start end)]
+  (let* ([t1 (wayfind start end 0)]
-                [(blizzards t2) (wayfind blizzards end start)]
+         [t2 (wayfind end start t1)]
-                [(blizzards t3) (wayfind blizzards start end)])
+         [t3 (wayfind start end t2)])
-    (values t1 (+ t1 t2 t3))))
+    (values t1 t3)))
 
 (show-solution part1 part2)