blob: be47f264be47814a23c84c6d04210339f278bb9c (
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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
#lang racket
(require advent-of-code
threading
data/applicative
data/monad
megaparsack
megaparsack/text
racket/struct)
(struct part (x m a s) #:transparent)
(struct rule (rating comparison threshold action) #:transparent)
(struct just (action) #:transparent)
(struct interval (from to))
(match-define (list raw-workflows raw-parts)
(~> (fetch-aoc-input (find-session) 2023 19 #:cache #true)
(string-split "\n\n")
(map (curryr string-split "\n") _)))
(define/match (to-getter _)
[(#\x) part-x]
[(#\m) part-m]
[(#\a) part-a]
[(#\s) part-s])
(define/match (to-comp _)
[(#\>) >]
[(#\<) <])
(define/match (to-action _)
[('(#\R)) 'reject]
[('(#\A)) 'accept]
[(name) (apply string name)])
(define rule/p
(do (or/p
(try/p (do [rating <- (char-in/p "xmas")]
[comparison <- (char-in/p "<>")]
[threshold <- integer/p]
(char/p #\:)
[action <- (many+/p letter/p)]
(pure (rule (to-getter rating) (to-comp comparison) threshold (to-action action)))))
(do [name <- (many+/p letter/p)] (pure (just (to-action name)))))))
(define rules/p
(do [name <- (many+/p letter/p)]
(char/p #\{)
[rules <- (many+/p rule/p #:sep (char/p #\,))]
(char/p #\})
(pure (cons (list->string name) rules))))
(define rating/p (do letter/p (char/p #\=) integer/p))
(define parts/p
(do (string/p "{")
[ratings <- (many/p rating/p #:sep (char/p #\,) #:min 4 #:max 4)]
(string/p "}")
(pure (apply part ratings))))
(define workflows
(~>> raw-workflows (map (λ~>> (parse-string rules/p) parse-result!)) make-immutable-hash))
(define parts (map (λ~>> (parse-string parts/p) parse-result!) raw-parts))
;; part 1
(define (evaluate-workflow p [workflow-name "in"])
(define rules (hash-ref workflows workflow-name))
(match (evaluate-rules p rules)
['accept (~> p struct->list (apply + _))]
['reject 0]
[name (evaluate-workflow p name)]))
(define (evaluate-rules p rules)
(match rules
[(list* (just action) _) action]
[(list* (rule rating comparison threshold action) _)
#:when (comparison (rating p) threshold)
action]
[(list* _ tail) (evaluate-rules p tail)]))
(for/sum ([p (in-list parts)]) (evaluate-workflow p))
;; part 2
(define (part-update-range pr rating interval)
(match rating
[(== part-x) (struct-copy part pr (x interval))]
[(== part-m) (struct-copy part pr (m interval))]
[(== part-a) (struct-copy part pr (a interval))]
[(== part-s) (struct-copy part pr (s interval))]))
(define (evaluate-workflow-on-range pr [workflow-name "in"])
(define rules (hash-ref workflows workflow-name))
(evaluate-rules-on-range pr rules))
(define (evaluate-rules-on-range pr rules)
(match rules
[(list* (just 'accept) _)
(~> pr struct->list (map (λ (i) (add1 (- (interval-to i) (interval-from i)))) _) (apply + _))]
[(list* (just 'reject) _) 0]
[(list* (just name) _) (evaluate-workflow-on-range pr name)]
[(list* (rule rating (== <) threshold action) tail)
(match-define (interval i-min i-max) (rating pr))
(define keep-i (part-update-range pr rating (interval i-min (sub1 threshold))))
(define pass-i (part-update-range pr rating (interval threshold i-max)))
(+ (evaluate-rules-on-range (part-update-range pr rating keep-i) (list (just action)))
(evaluate-rules-on-range (part-update-range pr rating pass-i) tail))]
[(list* (rule rating (== >) threshold action) tail)
(match-define (interval i-min i-max) (rating pr))
(define keep-i (part-update-range pr rating (interval (add1 threshold) i-max)))
(define pass-i (part-update-range pr rating (interval i-min threshold)))
(+ (evaluate-rules-on-range (part-update-range pr rating keep-i) (list (just action)))
(evaluate-rules-on-range (part-update-range pr rating pass-i) tail))]))
(define start-interval (interval 1 4000))
(evaluate-workflow-on-range (part start-interval start-interval start-interval start-interval))
|
