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"))