advent-of-code-2024

My solutions to AoC 2024
Log | Files | Refs

commit a757f2ccecb5b65c1c76e6099f2ae82a0d934f08
parent 4f33aa74e3fc0f489f1d20fe970de7370eb84f9f
Author: Lukas Henkel <lh@entf.net>
Date:   Tue, 17 Dec 2024 10:09:53 +0100

Day 17

Diffstat:
Ainput/17.txt | 5+++++
Asrc/day-17.lisp | 92+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
At/day-17.lisp | 31+++++++++++++++++++++++++++++++
3 files changed, 128 insertions(+), 0 deletions(-)

diff --git a/input/17.txt b/input/17.txt @@ -0,0 +1,5 @@ +Register A: 23999685 +Register B: 0 +Register C: 0 + +Program: 2,4,1,1,7,5,1,5,0,3,4,4,5,5,3,0 diff --git a/src/day-17.lisp b/src/day-17.lisp @@ -0,0 +1,92 @@ +(defpackage #:aoc/day-17 + (:use #:cl #:aoc/utils) + (:export + #:make-registers + #:run-program + #:day-17)) +(in-package #:aoc/day-17) + +(defun parse-register (line) + (parse-integer line :start (1+ (position #\: line)))) + +(defun make-registers (a &optional (b 0) (c 0)) + (make-array 3 + :element-type 'fixnum + :initial-contents (list a b c))) + +(defun parse-input (input) + (let ((a (parse-register (read-line input))) + (b (parse-register (read-line input))) + (c (parse-register (read-line input))) + (program-line (progn + (read-line input) + (read-line input)))) + (values (make-registers a b c) + (coerce (read-number-list program-line :start (1+ (position #\: program-line))) + 'vector)))) + +(declaim (inline combo-operand) + (ftype (function (fixnum (simple-array fixnum (3))) fixnum) combo-operand)) + +(defun combo-operand (operand registers) + (if (<= operand 3) + operand + (if (<= operand 7) + (aref registers (- operand 4)) + (error "Invalid operand ~A for combo operator" operand)))) + +(defun run-program (registers program) + (loop with output = nil + for ip from 0 below (length program) by 2 + for instruction = (aref program ip) + for operand = (aref program (1+ ip)) + do (case instruction + (0 (setf (aref registers 0) + (floor (aref registers 0) + (expt 2 (combo-operand operand registers))))) + (1 (setf (aref registers 1) + (logxor (aref registers 1) + operand))) + (2 (setf (aref registers 1) + (mod (combo-operand operand registers) 8))) + (3 (when (not (zerop (aref registers 0))) + (setf ip (- operand 2)))) + (4 (setf (aref registers 1) + (logxor (aref registers 1) + (aref registers 2)))) + (5 (push (mod (combo-operand operand registers) 8) output)) + (6 (setf (aref registers 1) + (floor (aref registers 0) + (expt 2 (combo-operand operand registers))))) + (7 (setf (aref registers 2) + (floor (aref registers 0) + (expt 2 (combo-operand operand registers)))))) + finally (return output))) + +(defun reset-registers (registers original-registers register-a) + (setf (aref registers 0) register-a + (aref registers 1) (aref original-registers 1) + (aref registers 2) (aref original-registers 2))) + +(defun task-2 (registers code) + (let ((original-registers (copy-seq registers))) + (labels ((%solve (register-a depth) + (loop for n from 0 below 8 + for nra = (+ register-a n) + do (reset-registers registers original-registers nra) + (let* ((res (run-program registers code)) + (value (nth depth res))) + (when (= value (aref code (- (length code) 1 depth))) + (when (= depth (1- (length code))) + (return-from %solve nra)) + (let ((solved-register-a (%solve (* nra 8) (1+ depth)))) + (when solved-register-a + (return-from %solve solved-register-a)))))))) + (%solve 1 0)))) + +(defun day-17 (input) + (multiple-value-bind (registers code) + (parse-input input) + (values + (format nil "~{~A~^,~}" (nreverse (run-program (copy-seq registers) code))) + (task-2 registers code)))) diff --git a/t/day-17.lisp b/t/day-17.lisp @@ -0,0 +1,31 @@ +(defpackage #:aoc-test/day-17 + (:use #:cl #:lisp-unit2 #:aoc/day-17)) +(in-package #:aoc-test/day-17) + +(define-test test-day-17 + () + (let ((registers (make-registers 0 0 9)) + (program (vector 2 6))) + (aoc/day-17:run-program registers program) + (assert= 1 (aref registers 1))) + (let ((registers (make-registers 10 0 0)) + (program (vector 5 0 5 1 5 4))) + (assert-equal (list 0 1 2) + (nreverse (run-program registers program)))) + (let ((registers (make-registers 2024 0 0)) + (program (vector 0 1 5 4 3 0))) + (assert-equal (list 4 2 5 6 7 7 7 7 3 1 0) + (nreverse (run-program registers program))) + (assert= 0 (aref registers 0))) + (let ((registers (make-registers 0 29 0)) + (program (vector 1 7))) + (run-program registers program) + (assert= 26 (aref registers 1))) + (let ((registers (make-registers 0 2024 43690)) + (program (vector 4 0))) + (run-program registers program) + (assert= 44354 (aref registers 1))) + (let ((registers (make-registers 729)) + (program (vector 0 1 5 4 3 0))) + (assert-equal (list 4 6 3 5 6 3 5 2 1 0) + (nreverse (run-program registers program)))))