blob: 4183ab98af8528424fcb268a343a16e350c49178 (
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
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
#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)
|
