aoc2021 day16

aoc2021-day16.lisp

;;;; +----------------------------------------------------------------+
;;;; | Advent of Code 2021                                            |
;;;; +----------------------------------------------------------------+

(defpackage #:snippets/aoc2021/day16
  (:use #:cl)
  (:export
   #:day16))

(in-package #:snippets/aoc2021/day16)

(defstruct packet
  version
  type-id
  payload)

(define-condition end-of-bit-stream (error)
  ())

(defun make-bit-stream (bits n)
  (let ((remaining n))
    (lambda (k)
      (if (plusp remaining)
          (prog1 (ldb (byte k (- remaining k)) bits)
            (decf remaining k))
          (error 'end-of-bit-stream)))))

(defun make-bit-stream-from-string (string)
  (let ((bits (parse-integer string :radix 16)))
    (make-bit-stream bits (* (length string) 4))))

(defun read-bits (bit-stream k)
  (funcall bit-stream k))

(defun read-literal-value (bit-stream)
  (let* ((bits-per-group 4)
         (groups
           (loop for more = (= 1 (read-bits bit-stream 1))
                 for group = (read-bits bit-stream bits-per-group)
                 collect group
                 until (not more)))
         (value 0)
         (pos (* bits-per-group (1- (length groups)))))
    (dolist (group groups)
      (setf (ldb (byte bits-per-group pos) value) group)
      (decf pos bits-per-group))
    value))

(defun read-subpackets (bit-stream)
  (ecase (read-bits bit-stream 1)
    (0
     (let* ((n (read-bits bit-stream 15))
            (bits (read-bits bit-stream n))
            (subpackets-bit-stream (make-bit-stream bits n)))
       (loop for packet = (read-packet subpackets-bit-stream)
             until (null packet)
             collect packet)))
    (1
     (loop repeat (read-bits bit-stream 11)
           collect (read-packet bit-stream)))))

(defun read-packet (bit-stream)
  (handler-case
      (let* ((version (read-bits bit-stream 3))
             (type-id (read-bits bit-stream 3))
             (payload (if (= type-id 4)
                          (read-literal-value bit-stream)
                          (read-subpackets bit-stream))))
        (make-packet :version version :type-id type-id :payload payload))
    (end-of-bit-stream ()
      nil)))

(defun decode (string)
  (let ((bit-stream (make-bit-stream-from-string string)))
    (read-packet bit-stream)))

(defun sum-version-numbers (packet)
  (+ (packet-version packet)
     (if (listp (packet-payload packet))
         (reduce #'+ (packet-payload packet) :key #'sum-version-numbers)
         0)))

(defvar *operators*
  #(+ * min max identity b> b< b=))

(defun b> (x y)
  (if (> x y) 1 0))

(defun b< (x y)
  (if (< x y) 1 0))

(defun b= (x y)
  (if (= x y) 1 0))

(defun evaluate (packet)
  ;; Replace APPLY with CONS to translate the packet into a Lisp
  ;; expression...
  (apply (aref *operators* (packet-type-id packet))
         (if (listp (packet-payload packet))
             (mapcar #'evaluate (packet-payload packet))
             (list (packet-payload packet)))))

(defun day16 (input)
  (let ((packet (decode input)))
    (list (sum-version-numbers packet)
          (evaluate packet))))