1 files changed, 91 insertions, 0 deletions
diff --git a/racket/aoc2023/day-05/day-05.rkt b/racket/aoc2023/day-05/day-05.rkt
new file mode 100644
index 0000000..5b9aa52
--- /dev/null
+++ b/racket/aoc2023/day-05/day-05.rkt
@@ -0,0 +1,91 @@
+#lang racket
+
+(require advent-of-code
+         algorithms
+         threading)
+
+(struct map-range (start end offset))
+(struct seed-range (start end))
+
+(define input (fetch-aoc-input (find-session) 2023 5 #:cache #true))
+
+(match-define (list* raw-seeds raw-mappings) (string-split input "\n\n"))
+
+(define seeds-naive (~> raw-seeds (string-split " ") rest (map string->number _)))
+(define mappers
+  (for/list ([raw-mapping (in-list raw-mappings)])
+    (for/lists (map-ranges #:result (sort map-ranges < #:key map-range-start))
+               ([raw-map-range (in-list (rest (string-split raw-mapping "\n")))]
+                #:do [(match-define (list dest source width)
+                        (~> raw-map-range (string-split _ " ") (map string->number _)))])
+               (map-range source (+ source width -1) (- dest source)))))
+
+;; part 1
+(define (in-map-range? n mr)
+  (<= (map-range-start mr) n (map-range-end mr)))
+
+(define (transform-value mapper n)
+  (match mapper
+    ['() n]
+    [(list* mr _)
+     #:when (in-map-range? n mr)
+     (+ n (map-range-offset mr))]
+    [(list* _ rest-mapper) (transform-value rest-mapper n)]))
+
+(for/lists (transforms #:result (apply min transforms))
+           ([seed (in-list seeds-naive)])
+           (foldl transform-value seed mappers))
+
+;; part 2
+(define (remap-range r mapper [acc '()])
+  (match-define (seed-range r-start r-end) r)
+  (match mapper
+    ; mapper exhausted
+    ['() (cons r acc)]
+    ; range to the left - not covered by this mapping, so keep as-is
+    [(list* (map-range m-start _ _) _)
+     #:when (< r-end m-start)
+     (cons r acc)]
+    ; range to the right - move to next map-range
+    [(list* (map-range _ m-end _) ms)
+     #:when (< m-end r-start)
+     (remap-range r ms acc)]
+    ; range is inside map-range - transform whole range
+    [(list* (map-range m-start m-end offset) _)
+     #:when (and (<= m-start r-start) (<= r-end m-end))
+     (cons (seed-range (+ r-start offset) (+ r-end offset)) acc)]
+    ; range overlaps start only - keep left side, transform right side
+    [(list* (map-range m-start m-end offset) ms)
+     #:when (and (< r-start m-start) (<= r-end m-end))
+     (remap-range (seed-range (add1 m-end) r-end)
+                  ms
+                  (cons (seed-range (+ m-start offset) (+ r-end offset)) acc))]
+    ; range overlaps end - transform left side, pass right side
+    [(list* (map-range m-start m-end offset) ms)
+     #:when (and (< m-start r-start) (<= m-end r-end))
+     (remap-range (seed-range (add1 m-end) r-end)
+                  ms
+                  (cons (seed-range (+ r-start offset) (+ m-end offset)) acc))]
+    ; range overlaps whole map-range - keep left side, transform middle, pass right side
+    [(list* (map-range m-start m-end offset) ms)
+     (remap-range (seed-range (add1 m-end) r-end)
+                  ms
+                  (cons (seed-range (+ m-start offset) (+ m-end offset))
+                        (cons (seed-range (add1 m-end) r-end) acc)))]))
+
+(define (remap-ranges rs mappers)
+  (cond
+    [(empty? mappers) rs]
+    [else
+     (~>> rs (append-map (curryr remap-range (first mappers))) (remap-ranges _ (rest mappers)))]))
+
+(~> seeds-naive
+    (chunks-of 2)
+    (map (λ (xs)
+           (match-define (list start width) xs)
+           (~> (list (seed-range start (+ start width -1)))
+               (remap-ranges mappers)
+               (argmin seed-range-start _)))
+         _)
+    (argmin seed-range-start _)
+    seed-range-start)