diff options
| -rw-r--r-- | 2021/day-16/day-16.rkt | 100 |
1 files changed, 78 insertions, 22 deletions
diff --git a/2021/day-16/day-16.rkt b/2021/day-16/day-16.rkt index c860e27..4183ab9 100644 --- a/2021/day-16/day-16.rkt +++ b/2021/day-16/day-16.rkt @@ -3,7 +3,7 @@ bitsyntax threading) -(struct packet (version id type value size) +(struct packet (version type type-id contents len) #:transparent) (define (BITS->bitstring str) @@ -13,22 +13,18 @@ (define data (~> (open-day 16 2021) - port->string - string-trim - BITS->bitstring)) - -(define (overflow l w) - (define extra (modulo l 4)) - (if (= extra 0) 0 (- w extra))) + port->string + string-trim + BITS->bitstring)) (define (get-literal-contents bitstr) (for/fold ([assembled (bit-string)] [remaining bitstr] [total-length 6] [complete? #f] - #:result (list (bit-string->integer assembled #t #f) - total-length - remaining)) + #:result (values (bit-string->integer assembled #t #f) + remaining + total-length)) ([_ (in-naturals)] #:break complete?) (bit-string-case remaining @@ -39,36 +35,96 @@ #f)) ([(= 0 :: bits 1) (number :: bits 4) - (ignored :: bits (overflow (+ total-length 5) 4)) (remaining :: binary)] (values (bit-string-append assembled (integer->bit-string number 4 #t)) remaining (+ total-length 5) #t))))) +(define (get-type-0-contents cnt bitstr [acc '()] [len 0]) + (cond + [(<= cnt 0) (values (reverse acc) + bitstr + len)] + [else (define-values (packet remaining) + (identify-next-packet bitstr)) + (get-type-0-contents (- cnt (packet-len packet)) + remaining + (cons packet acc) + (+ len (packet-len packet)))])) + +(define (get-type-1-contents cnt bitstr [acc '()] [len 0]) + (cond + [(= cnt 0) (values (reverse acc) + bitstr + len)] + [else (define-values (packet remaining) + (identify-next-packet bitstr)) + (get-type-1-contents (sub1 cnt) + remaining + (cons packet acc) + (+ len (packet-len packet)))])) + (define (identify-next-packet bitstr) (bit-string-case bitstr ([(packet-version :: bits 3) (= 4 :: bits 3) (remaining :: binary)] - (match-define (list n packet-length next-bitstr) (get-literal-contents remaining)) - (list (packet packet-version - 4 - 'literal - n - packet-length) - next-bitstr)) + (define-values (n now-remaining len) + (get-literal-contents remaining)) + (values (packet packet-version 'literal 4 n len) + now-remaining)) + ([(packet-version :: bits 3) (type-id :: bits 3) (= 0 :: bits 1) (subpacket-length :: bits 15) (remaining :: binary)] - (list (packet packet-version type-id 'type-0-operator 0 0) remaining)) + (define-values (contents now-remaining sublength) + (get-type-0-contents subpacket-length remaining)) + (values (packet packet-version 'operator type-id contents (+ 22 sublength)) + now-remaining)) + ([(packet-version :: bits 3) (type-id :: bits 3) (= 1 :: bits 1) (subpacket-count :: bits 11) (remaining :: binary)] - (list (packet packet-version type-id 'type-1-operator 0 0) remaining)))) + (define-values (contents now-remaining sublength) + (get-type-1-contents subpacket-count remaining)) + (values (packet packet-version 'operator type-id contents (+ 22 sublength)) + now-remaining)))) + +(match-define-values (outer-packet n) + (identify-next-packet data)) + +;; part 1 +(define (packet-sum-version p) + (match p + [(packet v 'literal _type-id _contents _len) v] + [(packet v 'operator _type-id ps _len) + (foldl (λ (p acc) (+ acc (packet-sum-version p))) v ps)])) + +(packet-sum-version outer-packet) + +;; part 2 +(define packet-f + (match-lambda + [0 +] + [1 *] + [2 min] + [3 max] + [5 (λ (a b) (if (> a b) 1 0))] + [6 (λ (a b) (if (< a b) 1 0))] + [7 (λ (a b) (if (= a b) 1 0))])) + +(define packet-eval + (match-lambda + [(packet _v 'literal _type-id n _len) n] + [(packet _v 'operator type-id ps _len) + (~>> ps + (map packet-eval) + (apply (packet-f type-id)))])) + +(packet-eval outer-packet) -(identify-next-packet (BITS->bitstring "D2FE28")) |