WASTL WHY WOULD YOU DO THIS

data/day16.txt

@@ -0,0 +1 @@
+6053231004C12DC26D00526BEE728D2C013AC7795ACA756F93B524D8000AAC8FF80B3A7A4016F6802D35C7C94C8AC97AD81D30024C00D1003C80AD050029C00E20240580853401E98C00D50038400D401518C00C7003880376300290023000060D800D09B9D03E7F546930052C016000422234208CC000854778CF0EA7C9C802ACE005FE4EBE1B99EA4C8A2A804D26730E25AA8B23CBDE7C855808057C9C87718DFEED9A008880391520BC280004260C44C8E460086802600087C548430A4401B8C91AE3749CF9CEFF0A8C0041498F180532A9728813A012261367931FF43E9040191F002A539D7A9CEBFCF7B3DE36CA56BC506005EE6393A0ACAA990030B3E29348734BC200D980390960BC723007614C618DC600D4268AD168C0268ED2CB72E09341040181D802B285937A739ACCEFFE9F4B6D30802DC94803D80292B5389DFEB2A440081CE0FCE951005AD800D04BF26B32FC9AFCF8D280592D65B9CE67DCEF20C530E13B7F67F8FB140D200E6673BA45C0086262FBB084F5BF381918017221E402474EF86280333100622FC37844200DC6A8950650005C8273133A300465A7AEC08B00103925392575007E63310592EA747830052801C99C9CB215397F3ACF97CFE41C802DBD004244C67B189E3BC4584E2013C1F91B0BCD60AA1690060360094F6A70B7FC7D34A52CBAE011CB6A17509F8DF61F3B4ED46A683E6BD258100667EA4B1A6211006AD367D600ACBD61FD10CBD61FD129003D9600B4608C931D54700AA6E2932D3CBB45399A49E66E641274AE4040039B8BD2C933137F95A4A76CFBAE122704026E700662200D4358530D4401F8AD0722DCEC3124E92B639CC5AF413300700010D8F30FE1B80021506A33C3F1007A314348DC0002EC4D9CF36280213938F648925BDE134803CB9BD6BF3BFD83C0149E859EA6614A8C

day16.rkt

@@ -0,0 +1,93 @@
+#lang racket
+(require "lib/common.rkt"
+         bitsyntax)
+
+(struct result (parsed length next) #:transparent)
+(struct literal (version value) #:transparent)
+(struct operator (version opcode subpackets) #:transparent)
+
+(define (hex-string->bit-string hex)
+  (integer->bit-string (string->number hex 16) (* 4 (string-length hex)) #t))
+
+(define (packet/p pkt)
+  (bit-string-case
+   pkt
+   ;; literal
+   ([(version :: bits 3) (= 4 :: bits 3) (rst :: binary)]
+    (match-define (result num len next) (literal/p rst))
+    (result (literal version num) (+ 6 (* 5 len)) next))
+   ;; type 0 operator
+   ([(version :: bits 3) (opcode :: bits 3) (= 0 :: bits 1) (to-parse :: bits 15) (rst :: binary)]
+    (match-define (result subpackets len next) (operator0/p rst to-parse))
+    (result (operator version opcode subpackets) (+ 22 len) next))
+   ([(version :: bits 3) (opcode :: bits 3) (= 1 :: bits 1) (to-parse :: bits 11) (rst :: binary)]
+    (match-define (result subpackets len next) (operator1/p rst to-parse))
+    (result (operator version opcode subpackets) (+ 18 len) next))))
+
+(define (literal/p lit)
+  (bit-string-case
+   lit
+   ([(= 1 :: bits 1) (v :: bits 4) (rst :: binary)]
+    (match-define (result val len next) (literal/p rst))
+    (result (+ (* (expt 16 len) v) val) (add1 len) next))
+   ([(= 0 :: bits 1) (v :: bits 4) (rst :: binary)]
+    (result v 1 rst))))
+
+(define (operator0/p subps len)
+  (define-values (subpackets rst)
+    (let loop ([cur-subpackets '()]
+               [cur-length 0]
+               [cur-remaining subps])
+      (cond [(>= cur-length len) (values (reverse cur-subpackets) cur-remaining)]
+            [else
+             (match-define (result packet len next) (packet/p cur-remaining))
+             (loop (cons packet cur-subpackets) (+ cur-length len) next)])))
+  (result subpackets len rst))
+
+(define (operator1/p subps len)
+  (define-values (subpackets length rst)
+    (for/fold ([cur-subpackets '()]
+               [cur-length 0]
+               [cur-remaining subps]
+               #:result (values (reverse cur-subpackets) cur-length cur-remaining))
+              ([_ (in-range len)])
+      (match-define (result packet len next) (packet/p cur-remaining))
+      (values (cons packet cur-subpackets) (+ cur-length len) next)))
+  (result subpackets length rst))
+
+(define (day16a input)
+  (define (sum-versions pkt)
+    (match pkt
+      [(literal version _) version]
+      [(operator version _ subps)
+       (apply + version (map sum-versions subps))]))
+
+  (sum-versions (result-parsed (packet/p (hex-string->bit-string input)))))
+
+(define (day16b input)
+  (define (eval pkt)
+    (match pkt
+      [(literal _ num) num]
+      [(operator _ 0 subps)
+       (apply + (map eval subps))]
+      [(operator _ 1 subps)
+       (apply * (map eval subps))]
+      [(operator _ 2 subps)
+       (apply min (map eval subps))]
+      [(operator _ 3 subps)
+       (apply max (map eval subps))]
+      [(operator _ 5 (list x y))
+       (if (> (eval x) (eval y)) 1 0)]
+      [(operator _ 6 (list x y))
+       (if (< (eval x) (eval y)) 1 0)]
+      [(operator _ 7 (list x y))
+       (if (= (eval x) (eval y)) 1 0)]))
+
+  (eval (result-parsed (packet/p (hex-string->bit-string input)))))
+
+(module+ main
+  (call-with-input-file "data/day16.txt"
+    (λ (prt)
+      (define input (string-trim (port->string prt)))
+      (answer 16 1 (day16a input))
+      (answer 16 2 (day16b input)))))