blob: 86083efac58d93cd5117578e4ea8441bbe830c92 (
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
|
#lang racket
(require "../../jj-aoc.rkt"
bitsyntax
threading)
(struct packet (version type type-id contents len) #:transparent)
(define (BITS->bitstring str)
(integer->bit-string (string->number str 16) (* 4 (string-length str)) #true))
(define data (~> (open-day 16 2021) port->string string-trim BITS->bitstring))
(define (get-literal-contents bitstr)
(for/fold ([assembled (bit-string)]
[remaining bitstr]
[total-length 6]
[complete? #f]
#:result (values (bit-string->integer assembled #t #f) remaining total-length))
([_ (in-naturals)] #:break complete?)
(bit-string-case remaining
([(= 1 :: bits 1) (number :: bits 4) (remaining :: binary)]
(values (bit-string-append assembled (integer->bit-string number 4 #t))
remaining
(+ total-length 5)
#f))
([(= 0 :: bits 1) (number :: bits 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)]
(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)]
(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)]
(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)
|
