blob: 5b9aa52afc6dc60b6c8965b1726ef337a604b6a8 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
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)
|
