day 16

16-packet-decoder/code.scm

@@ -0,0 +1,129 @@
+(import (srfi :43)) ; vector extensions 
+
+(define (>> x n) (bitwise-arithmetic-shift-right x n))
+(define (<< x n) (bitwise-arithmetic-shift-left x n))
+(define (& x n) (bitwise-and x n))
+
+; str is a string of hexadecimal numbers
+; bit-reader returns a closure that iterators over the bits
+; defined by the hex numbers over the requested amount.
+; if 'position is sent to closure instead of a number,
+; the current bit position in the stream is returned.
+(define (bit-reader str)
+  (let [(index -1)
+	(len (string-length str))
+	(available 0)
+	(nibble #f)]
+    (lambda (want)
+      (case want
+	['position (+ (* index 4) (- 4 available))]
+	[else 
+	  (let reader [(want want)]
+	    (when (= available 0)
+	      (set! index (+ index 1))
+	      (set! nibble 
+		(if (< index len)
+		  (string->number (substring str index (+ index 1)) 16)
+		  #f))
+	      (set! available 4))
+	    (if nibble
+	      (let* [(consume (min want available))
+		     (offset (- 4 consume))
+		     (mask (- (<< 1 consume) 1))
+		     (result (>> (& nibble (<< mask offset)) offset))]
+		(set! nibble (<< nibble consume))
+		(set! available (- available consume))
+		(if (< consume want)
+		  (let [(left (- want consume))]
+		    (+ (<< result left) (reader left)))
+		  result))
+	      #f))]))))
+
+; given a bit-reader, this decodes a variable width integer
+; where each packet is 5 bits and a leading bit of 1 tells
+; there is one more packet to read
+(define (decode-integer br)
+  (let loop [(value 0)]
+    (let* [(more? (= (br 1) 1))
+	   (bits (br 4))
+	   (value (+ (* value 16) bits))]
+      (if more?
+	(loop value)
+	value))))
+
+; this decodes each packet in the given hex string
+; calling visitor for each with the version type and value of each packet
+; for a packet of type 4, value is the literal value of the packet
+; for other packets, value is the number of arguments to the opcode.
+(define (decode str visitor)
+  (let [(br (bit-reader str))]
+    (let loop ()
+      (let* [(version (br 3))
+	     (type (br 3))]
+	(if (= type 4)
+	  (visitor version type (decode-integer br))
+	  (let [(length-type (br 1))]
+	    (if (= length-type 0)
+	      (let* [(to-decode (br 15))
+		     (start (br 'position))]
+		(let sub [(count 1)]
+		  (loop)
+		  (if (< (- (br 'position) start) to-decode)
+		    (sub (+ count 1))
+		    (visitor version type count))))
+	      (let [(count (br 11))]
+		(let sub [(n count)]
+		  (loop)
+		  (if (> n 1)
+		    (sub (- n 1))
+		    (visitor version type count)))))))))))
+
+; returns the sum of all version numbers of all the packets in the given encoded BITS stream
+(define (sum-versions str)
+  (let [(sum-version 0)]
+    (decode str (lambda (version type value)
+		  (set! sum-version (+ version sum-version))))
+    sum-version))
+
+; given a stack, pops "value" as many elements
+; and returns a stack with a new head with
+; op concatenated with the popped values.
+; the rest of the original stack follows
+(define (do-op op stack value)
+  (let rec [(stack stack) (got 0) (output '())]
+    (if (= got value)
+      (cons (cons op output) stack)
+      (let [(v (car stack))]
+	(rec (cdr stack) (+ got 1) (cons v output))))))
+
+; we can't use regular scheme operators for the evaluation of the BITS stream
+; because they return #t/#f instead of 1 0
+; so these 3 are helpers to solve the situation
+(define (greater-than a b) (if (> a b) 1 0))
+(define (less-than a b) (if (< a b) 1 0))
+(define (equal-to a b) (if (= a b) 1 0))
+
+; decodes the operation given by the BITS encoded stream and evaluates it
+(define (evaluate str)
+  (let [(stack '())]
+    (decode str
+	    (lambda (version type value)
+	      (set! stack
+		(case type
+		  [0 (do-op '+ stack value)]
+		  [1 (do-op '* stack value)]
+		  [2 (do-op 'min stack value)]
+		  [3 (do-op 'max stack value)]
+		  [4 (cons value stack)]
+		  [5 (do-op 'greater-than stack value)]
+		  [6 (do-op 'less-than stack value)]
+		  [7 (do-op 'equal-to stack value)]))))
+    (eval (car stack))))
+
+(call-with-input-file
+  "input"
+  (lambda (file)
+    (let [(data (get-line file))]
+      (printf "part 1:~% Sum of version numbers ~a~%" (sum-versions data))
+      (printf "part 2:~% Transmission value: ~a~%" (evaluate data)))))
+

16-packet-decoder/input

@@ -0,0 +1 @@
+220D4B80491FE6FBDCDA61F23F1D9B763004A7C128012F9DA88CE27B000B30F4804D49CD515380352100763DC5E8EC000844338B10B667A1E60094B7BE8D600ACE774DF39DD364979F67A9AC0D1802B2A41401354F6BF1DC0627B15EC5CCC01694F5BABFC00964E93C95CF080263F0046741A740A76B704300824926693274BE7CC880267D00464852484A5F74520005D65A1EAD2334A700BA4EA41256E4BBBD8DC0999FC3A97286C20164B4FF14A93FD2947494E683E752E49B2737DF7C4080181973496509A5B9A8D37B7C300434016920D9EAEF16AEC0A4AB7DF5B1C01C933B9AAF19E1818027A00A80021F1FA0E43400043E174638572B984B066401D3E802735A4A9ECE371789685AB3E0E800725333EFFBB4B8D131A9F39ED413A1720058F339EE32052D48EC4E5EC3A6006CC2B4BE6FF3F40017A0E4D522226009CA676A7600980021F1921446700042A23C368B713CC015E007324A38DF30BB30533D001200F3E7AC33A00A4F73149558E7B98A4AACC402660803D1EA1045C1006E2CC668EC200F4568A5104802B7D004A53819327531FE607E118803B260F371D02CAEA3486050004EE3006A1E463858600F46D8531E08010987B1BE251002013445345C600B4F67617400D14F61867B39AA38018F8C05E430163C6004980126005B801CC0417080106005000CB4002D7A801AA0062007BC0019608018A004A002B880057CEF5604016827238DFDCC8048B9AF135802400087C32893120401C8D90463E280513D62991EE5CA543A6B75892CB639D503004F00353100662FC498AA00084C6485B1D25044C0139975D004A5EB5E52AC7233294006867F9EE6BA2115E47D7867458401424E354B36CDAFCAB34CBC2008BF2F2BA5CC646E57D4C62E41279E7F37961ACC015B005A5EFF884CBDFF10F9BFF438C014A007D67AE0529DED3901D9CD50B5C0108B13BAFD6070