more progress on day 16

1 files changed, 64 insertions, 20 deletions

diff --git a/2021/day-16/day-16.rkt b/2021/day-16/day-16.rkt
index 80c2a54..c860e27 100644
--- a/2021/day-16/day-16.rkt
+++ b/2021/day-16/day-16.rkt
@@ -1,30 +1,74 @@
 #lang racket
 (require "../../jj-aoc.rkt"
+         bitsyntax
          threading)
 
+(struct packet (version id type value size)
+  #: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
-      string->list))
+      BITS->bitstring))
+
+(define (overflow l w)
+  (define extra (modulo l 4))
+  (if (= extra 0) 0 (- w extra)))
+
+(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))
+            ([_ (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)
+                       (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 (hex->bin h)
-  (match h
-    [#\0 '(0 0 0 0)]
-    [#\1 '(0 0 0 1)]
-    [#\2 '(0 0 1 0)]
-    [#\3 '(0 0 1 1)]
-    [#\4 '(0 1 0 0)]
-    [#\5 '(0 1 0 1)]
-    [#\6 '(0 1 1 0)]
-    [#\7 '(0 1 1 1)]
-    [#\8 '(1 0 0 0)]
-    [#\9 '(1 0 0 1)]
-    [#\A '(1 0 1 0)]
-    [#\B '(1 0 1 1)]
-    [#\C '(1 1 0 0)]
-    [#\D '(1 1 0 1)]
-    [#\E '(1 1 1 0)]
-    [#\F '(1 1 1 1)]))
+(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))
+                   ([(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))
+                   ([(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))))
 
-(map hex->bin data)
\ No newline at end of file
+(identify-next-packet (BITS->bitstring "D2FE28"))