day 5: refactor

5.rkt

@@ -6,54 +6,27 @@
 
 (struct rngmap [dst src len] #:transparent)
 
-(define (transform-layer num mapping)
-  (or
-    (for/first ([entry (in-list mapping)]
-                #:do [(match-define (rngmap dst src len) entry)]
-                #:when (>= num src)
-                #:when (< num (+ src len)))
-      (+ dst (- num src)))
-    num))
-
-(define (transform-all num mappings)
-  (for/fold ([cur-num num]) ([mapping (in-list mappings)])
-    (transform-layer cur-num mapping)))
+(define (transform-layer mapping iset)
+  (for/fold ([cur-src iset] [cur-dst (is:make-empty)]
+             #:result (is:union cur-src cur-dst))
+            ([entry (in-list mapping)] #:do [(match-define (rngmap dst src len) entry)])
+    (define src-range (is:make-xrange src (+ src len)))
+    (define transform-src (is:intersect cur-src src-range))
+    (define transform-dst
+      (is:map #{cons (+ dst (- (car %) src)) (+ dst (- (cdr %) src))} transform-src))
+    (values (is:subtract cur-src src-range) (is:union cur-dst transform-dst))))
 
 (define (part1 input)
-  (apply min
-         (for/list ([num (in-list (first input))])
-           (transform-all num (rest input)))))
-
-(define (part2-transform-layer iset mapping)
-  (define-values [rem-src dst]
-    (for/fold ([cur-src iset] [cur-dst (is:make-integer-set '())])
-              ([entry (in-list mapping)]
-               #:do [(match-define (rngmap dst src len) entry)])
-      (define entry-src (is:make-range src (+ src (sub1 len))))
-      (define captured-values (is:intersect cur-src entry-src))
-      (define captured-wfs (is:integer-set-contents captured-values))
-      (define transformed-wfs
-        (for/list ([wfs-entry (in-list captured-wfs)])
-          (cons (+ dst (- (car wfs-entry) src))
-                (+ dst (- (cdr wfs-entry) src)))))
-      (define transformed-iset (is:make-integer-set transformed-wfs))
-      (values (is:subtract cur-src entry-src) (is:union cur-dst transformed-iset))))
-  (is:union rem-src dst))
-
-(define (part2-transform-all iset mappings)
-  (for/fold ([cur-iset iset]) ([mapping (in-list mappings)])
-    (part2-transform-layer cur-iset mapping)))
+  (~> (foldl transform-layer (is:make-range* (first input)) (rest input))
+      is:integer-set-contents first car))
 
 (define (part2 input)
-  (define ranges (first input))
-  (define ranges-iset
-    (for/fold ([is (is:make-integer-set '())])
-              ([chunk (in-slice 2 (in-list ranges))])
-        (is:union is
-                  (is:make-range (first chunk) (+ (first chunk) (sub1 (second chunk)))))))
-  (define mappings (rest input))
-  (define ranges-out (part2-transform-all ranges-iset mappings))
-  (car (first (is:integer-set-contents ranges-out))))
+  (define init-range
+    (~> (for/list ([range (in-slice 2 (first input))])
+          (cons (first range) (+ (first range) (second range))))
+        is:make-xrange*))
+  (~> (foldl transform-layer init-range (rest input))
+      is:integer-set-contents first car))
 
 (define (parse fname)
   (match-define (cons initial mappings) (string-split (file->string fname) "\n\n"))
@@ -66,9 +39,6 @@
         (rngmap dst src len))))
   (cons initial-nums mapping-nums))
 
-; (part2 (parse "inputs/5-test1"))
-; (error)
-
 (module+ main
   (define input (parse "inputs/5"))
   (answer 5 1 (time (part1 input)))

scripts/aoc.rkt

@@ -8,6 +8,7 @@
          band bor bxor bnot bshl bshr bset? bfield
          string-reverse
          maximum-bipartite-matching/stable
+         is:make-empty is:make-xrange is:make-range* is:make-xrange* is:map
          (all-from-out data/integer-set graph syntax/parse/define threading)
          (for-syntax (all-from-out racket/syntax)))
 
@@ -58,6 +59,46 @@
     matching
     (map #{list (second %) (first %)} matching)))
 
+;; integer set helpers
+
+;; makes an empty integer-set, alias for is:make-range with no args
+(define (is:make-empty)
+  (is:make-range))
+
+;; makes an integer-set from an exclusive range, ie [start, end)
+(define (is:make-xrange start end)
+  (is:make-range start (sub1 end)))
+
+(define ((is:make-range*-maker is:maker) ranges)
+  (for/fold ([iset (is:make-empty)]) ([range (in-list ranges)])
+    (is:union iset
+              (match range
+                [(list start end) (is:maker start end)]
+                [(cons start '()) (is:maker start)]
+                [(cons start end) (is:maker start end)]
+                [start (is:maker start)]))))
+
+;; makes an integer set from a list of ranges
+;; the result will be the union of every element in the given list
+;; each element can be
+;; - (list start end) - [start, end]
+;; - (cons start end) - [start, end]
+;; - (list start)     - [start, start]
+;; - start            - [start, start]
+;; the individual ranges need not be well-formed
+(define is:make-range* (is:make-range*-maker is:make-range))
+;; similar to is:make-range* but each element can be
+;; - (list start end) - [start, end)
+;; - (cons start end) - [start, end)
+(define is:make-xrange* (is:make-range*-maker is:make-xrange))
+
+;; applies a mapping function to each individual continuous range in the integer set
+;; returns the union of the resulting ranges
+;; each range is in the integer-set wfs format, ie inclusive [start, end]
+;; the output ranges need not be in well-formed order
+(define (is:map mapper iset)
+  (is:make-range* (map mapper (is:integer-set-contents iset))))
+
 ;; submit a solution to the server if not already submitted
 (define (answer day part answer)
   (printf "answer ~a.~a: ~s\n" day part answer)