From 8f06defb1eb5d2e14c0444247fda2cec01e66bda Mon Sep 17 00:00:00 2001 From: Samuel Hunter Date: Wed, 15 Dec 2021 22:14:03 -0800 Subject: [PATCH] Refactor Day 15 --- day16.lisp | 129 +++++++++++++++++++++++++++++------------------------ 1 file changed, 70 insertions(+), 59 deletions(-) diff --git a/day16.lisp b/day16.lisp index b4202f5..0d8fcea 100644 --- a/day16.lisp +++ b/day16.lisp @@ -1,5 +1,5 @@ (defpackage #:advent2021.day16 - (:use #:cl #:alexandria #:cl-ppcre #:queues #:advent2021.util) + (:use #:cl #:alexandria #:advent2021.util) (:export #:solve-part-1 #:solve-part-2)) (in-package #:advent2021.day16) @@ -8,10 +8,11 @@ (defun hex2val (c) (if (<= (char-code #\0) (char-code c) (char-code #\9)) - (- (char-code c) (char-code #\0)) - (- (char-code (char-upcase c)) (char-code #\A) -10))) + (- (char-code c) (char-code #\0)) ;; 0..9 + (- (char-code (char-upcase c)) (char-code #\A) -10))) ;; A..F (defparameter +input+ + ;; Flatten the hex puzzle input into a bit-array. (loop :with line := (with-puzzle-file (stream) (read-line stream)) :with array := (make-array (* 4 (length line)) @@ -19,27 +20,48 @@ :for c :across line :for nybble := (hex2val c) :for i :upfrom 0 :by 4 - :do (setf (aref array i) (logand 1 (ash nybble -3))) - :do (setf (aref array (+ 1 i)) (logand 1 (ash nybble -2))) - :do (setf (aref array (+ 2 i)) (logand 1 (ash nybble -1))) - :do (setf (aref array (+ 3 i)) (logand 1 (ash nybble -0))) + :do (setf (aref array i) (logand 1 (ash nybble -3)) + (aref array (+ 1 i)) (logand 1 (ash nybble -2)) + (aref array (+ 2 i)) (logand 1 (ash nybble -1)) + (aref array (+ 3 i)) (logand 1 (ash nybble -0))) :finally (return array))) -(defun reader () - (cons 0 nil)) +(defconstant +literal-type+ 4) -(defun pos (reader) - (car reader)) +(defmacro defgetf-accessor (name indicator) + "Define an inline-desirable wrapper function around getf." + `(progn + (declaim (inline ,name)) + ;; XXX this macro leaks symbols NEW-VALUE and PLACE to the INDICATOR + ;; param. I'd rather not change it to use gensyms though, because I want + ;; those symbol names to be present in the function documentation, and the + ;; indicators are only keywords in practice anyways. + (defun ,name (place) + (getf place ,indicator)) + (defun (setf ,name) (new-value place) + (setf (getf place ,indicator) new-value)))) -(defun (setf pos) (new-value reader) - (setf (car reader) new-value)) +(defun make-reader () + (list :pos 0)) + +(defgetf-accessor pos :pos) + +(defun make-packet (version type payload) + (list :version version :type type + (if (= type +literal-type+) + :value :subpackets) payload)) + +(defgetf-accessor ptype :type) +(defgetf-accessor version :version) +(defgetf-accessor value :value) +(defgetf-accessor subpackets :subpackets) (defun read-bits (reader size) (loop :with start := (pos reader) :with result := 0 :for i :from start :below (+ start size) - :do (setf result (+ (ash result 1) - (aref +input+ i))) + :do (setf result (logior (ash result 1) + (aref +input+ i))) :finally (incf (pos reader) size) (return result))) @@ -51,61 +73,50 @@ :while (= (logand #b10000 group) #b10000) :finally (return result))) -(defun read-subpackets-to-length (reader length) - (loop :with start := (pos reader) - :collect (read-packet reader) - :while (< (- (pos reader) start) length))) - (defun read-packet (reader) (let ((version (read-bits reader 3)) (type (read-bits reader 3))) (cond + ;; simple (literal-value) packet: ((= type 4) - (list :version version :type type - :value (read-literal reader))) + (make-packet version type (read-literal reader))) + ;; sized compound packet: ((= 0 (read-bits reader 1)) - (list :version version :type type - :subpackets (read-subpackets-to-length - reader (read-bits reader 15)))) - (t - (list :version version :type type - :subpackets (loop :repeat (read-bits reader 11) - :collect (read-packet reader))))))) + (make-packet version type + (loop :with end := (+ (read-bits reader 15) + (pos reader)) + :collect (read-packet reader) + :until (= (pos reader) end) + :do (assert (not (> (pos reader) end)))))) + ;; sizeless compound packet: + (t (make-packet version type + (loop :repeat (read-bits reader 11) + :collect (read-packet reader))))))) (defun sum-versions (packet) - (if (= 4 (getf packet :type)) - (getf packet :version) - (+ (getf packet :version) - (loop :for subpacket :in (getf packet :subpackets) - :sum (sum-versions subpacket))))) + (+ (version packet) + (reduce #'+ (mapcar #'sum-versions (subpackets packet))))) (defun solve-part-1 () - (sum-versions (read-packet (reader)))) - -(defun packet-type (packet) - (getf packet :type)) - -(defun subpackets (packet) - (getf packet :subpackets)) + (sum-versions (read-packet (make-reader)))) (defun eval-packet (packet) - (eswitch (packet :key #'packet-type) - (0 (reduce #'+ (mapcar #'eval-packet (subpackets packet)))) - (1 (reduce #'* (mapcar #'eval-packet (subpackets packet)))) - (2 (reduce #'min (mapcar #'eval-packet (subpackets packet)))) - (3 (reduce #'max (mapcar #'eval-packet (subpackets packet)))) - (4 (getf packet :value)) - (5 (if (> (eval-packet (first (subpackets packet))) - (eval-packet (second (subpackets packet)))) - 1 0)) - (6 (if (< (eval-packet (first (subpackets packet))) - (eval-packet (second (subpackets packet)))) - 1 0)) - (7 (if (= (eval-packet (first (subpackets packet))) - (eval-packet (second (subpackets packet)))) - 1 0)))) + (etypecase (ptype packet) + ;; n-ary arithmetic compound packet: + ((integer 0 3) + (reduce (nth (ptype packet) + (list #'+ #'* #'min #'max)) + (mapcar #'eval-packet (subpackets packet)))) + ;; simple (literal-value) packet: + ((eql 4) + (value packet)) + ;; binary test compound packet: + ((integer 5 7) + (if (funcall (nth (- (ptype packet) 5) + (list #'> #'< #'=)) + (eval-packet (first (subpackets packet))) + (eval-packet (second (subpackets packet)))) + 1 0)))) (defun solve-part-2 () - (eval-packet (read-packet (reader)))) - - + (eval-packet (read-packet (make-reader)))) -- 2.45.2