Advent of Code 2020 solutions in Racket, I guess
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

129 lines
4.3 KiB

#lang racket
(require "lib/common.rkt"
data/applicative data/monad
megaparsack megaparsack/text)
(provide parse-solver)
(struct rule (name lower1 upper1 lower2 upper2) #:transparent)
(define whitespace/p (many/p space/p))
(define newline/p (char/p #\newline))
(define range/p
(do [lower <- integer/p]
(char/p #\-)
[upper <- integer/p]
(pure (cons lower upper))))
(define rule/p
(do [name <- (many+/p (char-not/p #\:))]
(char/p #\:)
[range1 <- range/p]
(string/p "or")
[range2 <- range/p]
(pure (list (list->string name)
(car range1) (cdr range1)
(car range2) (cdr range2)))))
(define csv/p
(do [num <- integer/p]
(or/p (try/p (char/p #\,)) void/p)
(pure num))))
(define rules/p (many+/p rule/p #:sep newline/p))
(define your/p
(do (string/p "your ticket:")
[your <- csv/p]
(pure your)))
(define nearby/p
(do (string/p "nearby tickets:")
[nearby <- (many+/p csv/p #:sep newline/p)]
(pure nearby)))
(define (parse prt)
(match-define (list rules/u your/u nearby/u) (string-split (port->string prt) "\n\n"))
(define rules
(for/list ([rl (in-list (parse-result! (parse-string rules/p rules/u)))])
(match-define (list name lower1 upper1 lower2 upper2) rl)
(rule name lower1 upper1 lower2 upper2)))
(values rules
(parse-result! (parse-string your/p your/u))
(parse-result! (parse-string nearby/p nearby/u))))
(define (parse-solver prt)
(define (distance-to-d str)
(define fst (string-ref str 0))
(abs (- (char->integer fst) (char->integer #\d))))
(match-define (list rules/u your/u nearby/u) (string-split (port->string prt) "\n\n"))
(define rules/sorted (sort (parse-result! (parse-string rules/p rules/u))
(λ (x y) (< (distance-to-d (first x))
(distance-to-d (first y))))))
(define rules
(for/list ([rl (in-list rules/sorted)]
[idx (in-naturals)])
(match-define (list _ lower1 upper1 lower2 upper2) rl)
(list idx lower1 upper1 lower2 upper2)))
(values rules
(parse-result! (parse-string your/p your/u))
(parse-result! (parse-string nearby/p nearby/u))))
(define (field-valid? num rule)
(or (<= (rule-lower1 rule) num (rule-upper1 rule))
(<= (rule-lower2 rule) num (rule-upper2 rule))))
(define (field-invalid-for-all? num rules)
(not (for/or ([rule (in-list rules)])
(field-valid? num rule))))
(define (day16a rules nearby)
(for*/sum ([ticket (in-list nearby)]
[num (in-list ticket)]
#:when (field-invalid-for-all? num rules))
(define (ticket-invalid-for-all? ticket rules)
(for/or ([num (in-list ticket)])
(field-invalid-for-all? num rules)))
(define (valid-tickets rules nearby)
(filter (λ (t) (and (not (ticket-invalid-for-all? t rules))
(not (empty? t))))
(define (day16b rules your nearby)
(define (remove-duplicates! mapping)
(define still-has-conflicts #f)
(for ([ticket (in-vector mapping)]
[idx (in-naturals)])
(cond [(= 1 (set-count ticket))
(define rule (set-first ticket))
(for ([ticket2 (in-vector mapping)]
[idx2 (in-naturals)]
#:unless (= idx idx2))
(set-remove! ticket2 rule))]
[else (set! still-has-conflicts #t)]))
(when still-has-conflicts (remove-duplicates! mapping)))
(define valid (valid-tickets rules nearby))
(define mapping
(for/vector ([idx (in-range (length your))])
(for/mutable-set ([rule (in-list rules)]
#:when (andmap (λ (t) (field-valid? (list-ref t idx) rule)) valid))
(remove-duplicates! mapping)
(define actual-mapping-i-hate-myself
(vector-map (compose rule-name set-first) mapping))
(for/product ([fld (in-list your)]
[rule (in-vector actual-mapping-i-hate-myself)])
(if (string-contains? rule "departure") fld 1)))
(module+ main
(call-with-input-file "data/day16.txt"
(λ (prt)
(define-values (rules your nearby) (parse prt))
(answer 16 1 (day16a rules nearby))
(answer 16 2 (day16b rules your nearby)))))