alexandria-ocasio-cortez axiom-of-choice area-of-concern american-orthodox-church almost-optimal-coset solutions in the year of our lord 2021, 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.

93 lines
3.3 KiB

#lang racket
(require "lib/common.rkt"
bitsyntax)
(struct result (parsed length next) #:transparent)
(struct literal (version value) #:transparent)
(struct operator (version opcode subpackets) #:transparent)
(define (hex-string->bit-string hex)
(integer->bit-string (string->number hex 16) (* 4 (string-length hex)) #t))
(define (packet/p pkt)
(bit-string-case
pkt
;; literal
([(version :: bits 3) (= 4 :: bits 3) (rst :: binary)]
(match-define (result num len next) (literal/p rst))
(result (literal version num) (+ 6 (* 5 len)) next))
;; type 0 operator
([(version :: bits 3) (opcode :: bits 3) (= 0 :: bits 1) (to-parse :: bits 15) (rst :: binary)]
(match-define (result subpackets len next) (operator0/p rst to-parse))
(result (operator version opcode subpackets) (+ 22 len) next))
([(version :: bits 3) (opcode :: bits 3) (= 1 :: bits 1) (to-parse :: bits 11) (rst :: binary)]
(match-define (result subpackets len next) (operator1/p rst to-parse))
(result (operator version opcode subpackets) (+ 18 len) next))))
(define (literal/p lit)
(bit-string-case
lit
([(= 1 :: bits 1) (v :: bits 4) (rst :: binary)]
(match-define (result val len next) (literal/p rst))
(result (+ (* (expt 16 len) v) val) (add1 len) next))
([(= 0 :: bits 1) (v :: bits 4) (rst :: binary)]
(result v 1 rst))))
(define (operator0/p subps len)
(define-values (subpackets rst)
(let loop ([cur-subpackets '()]
[cur-length 0]
[cur-remaining subps])
(cond [(>= cur-length len) (values (reverse cur-subpackets) cur-remaining)]
[else
(match-define (result packet len next) (packet/p cur-remaining))
(loop (cons packet cur-subpackets) (+ cur-length len) next)])))
(result subpackets len rst))
(define (operator1/p subps len)
(define-values (subpackets length rst)
(for/fold ([cur-subpackets '()]
[cur-length 0]
[cur-remaining subps]
#:result (values (reverse cur-subpackets) cur-length cur-remaining))
([_ (in-range len)])
(match-define (result packet len next) (packet/p cur-remaining))
(values (cons packet cur-subpackets) (+ cur-length len) next)))
(result subpackets length rst))
(define (day16a input)
(define (sum-versions pkt)
(match pkt
[(literal version _) version]
[(operator version _ subps)
(apply + version (map sum-versions subps))]))
(sum-versions (result-parsed (packet/p (hex-string->bit-string input)))))
(define (day16b input)
(define (eval pkt)
(match pkt
[(literal _ num) num]
[(operator _ 0 subps)
(apply + (map eval subps))]
[(operator _ 1 subps)
(apply * (map eval subps))]
[(operator _ 2 subps)
(apply min (map eval subps))]
[(operator _ 3 subps)
(apply max (map eval subps))]
[(operator _ 5 (list x y))
(if (> (eval x) (eval y)) 1 0)]
[(operator _ 6 (list x y))
(if (< (eval x) (eval y)) 1 0)]
[(operator _ 7 (list x y))
(if (= (eval x) (eval y)) 1 0)]))
(eval (result-parsed (packet/p (hex-string->bit-string input)))))
(module+ main
(call-with-input-file "data/day16.txt"
(λ (prt)
(define input (string-trim (port->string prt)))
(answer 16 1 (day16a input))
(answer 16 2 (day16b input)))))