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.

104 lines
3.2 KiB

#lang racket
(require "lib/common.rkt"
data/applicative data/monad
megaparsack megaparsack/parser-tools/lex
parser-tools/lex (prefix-in : parser-tools/lex-sre))
(provide (all-defined-out))
(struct rule (idx obj) #:transparent)
(struct orr (left right) #:transparent)
(define-tokens rules [NUMBER CHARACTER])
(define-empty-tokens rules* [COLON PIPE QUOTE NEWLINE])
(define number/p (token/p 'NUMBER))
(define character/p (token/p 'CHARACTER))
(define colon/p (token/p 'COLON))
(define pipe/p (token/p 'PIPE))
(define quote/p (token/p 'QUOTE))
(define newline/p (token/p 'NEWLINE))
(define rules-lexer
[#\: (token-COLON)]
[#\| (token-PIPE)]
[#\" (token-QUOTE)]
[#\newline (token-NEWLINE)]
[(:+ (:/ #\0 #\9))
(token-NUMBER (string->number lexeme))]
[(:+ (:/ #\a #\z))
(token-CHARACTER lexeme)]
[(:or whitespace blank iso-control) (void)]
[(eof) eof]))
(define number-list/p (many/p number/p))
(define quoted-char/p
(do quote/p
[ch <- character/p]
(pure (string-ref ch 0))))
(define piped-numbers/p
(do [lhs <- number-list/p]
[rhs <- number-list/p]
(pure (orr lhs rhs))))
(define rule-rhs/p (or/p quoted-char/p (try/p piped-numbers/p) number-list/p))
(define rule/p
(do [idx <- number/p]
[object <- rule-rhs/p]
(pure (rule idx object))))
(define rules/p (many/p rule/p #:sep newline/p))
(define (parse prt)
(match-define `(,rls ,msgs) (string-split (port->string prt) "\n\n"))
(define rls/parsed (parse-result! (parse-tokens rules/p (lex-string rules-lexer rls))))
(define rls/hash
(for/hash ([v (in-list rls/parsed)])
(values (rule-idx v) v)))
(values rls/hash (string-split msgs "\n")))
(define (day19a rls msgs)
(define brag-formatted
(for/list ([(_ rl) (in-hash rls)])
(match-define (rule idx obj) rl)
(format "rule~a: ~a\n" idx
(match obj
[ch #:when (char? ch) (format "\"~a\"" ch)]
[indices #:when (list? indices)
(string-join (map (compose1 (curry string-append "rule") number->string) indices) " ")]
[(orr lhs rhs)
(string-join (map (compose1 (curry string-append "rule") number->string) lhs) " ")
" | "
(string-join (map (compose1 (curry string-append "rule") number->string) rhs) " "))])))))
(define brag-data
(string-append "#lang brag\ntop: rule0\n" brag-formatted))
(define tmp (make-temporary-file))
(call-with-output-file tmp
(λ (prt)
(write-string brag-data prt))
#:exists 'truncate)
(define parse (dynamic-require tmp 'parse))
(for/sum ([msg (in-list msgs)])
(with-handlers ([exn:fail? (lambda (_) 0)])
(parse msg) 1)))
(define (day19b rls msgs)
; 8: 42 | 42 8
; 11: 42 31 | 42 11 31
(define new-rls
(hash-set* rls
8 (rule 8 (orr (list 42) (list 42 8)))
11 (rule 11 (orr (list 42 31) (list 42 11 31)))))
(day19a new-rls msgs))
(module+ main
(call-with-input-file "data/day19.txt"
(λ (prt)
(define-values (rls msgs) (parse prt))
(answer 19 1 (day19a rls msgs))
(answer 19 2 (day19b rls msgs)))))