diff --git a/5.rkt b/5.rkt index af8570f..bf3afa6 100644 --- a/5.rkt +++ b/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))) diff --git a/scripts/aoc.rkt b/scripts/aoc.rkt index b39ecb0..57c49e3 100644 --- a/scripts/aoc.rkt +++ b/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)