Add 2024 day 17 solutions

3 files changed, 114 insertions, 0 deletions

diff --git a/2024/17/machine.lisp b/2024/17/machine.lisp
new file mode 100644
index 0000000..31ae24f
--- /dev/null
+++ b/2024/17/machine.lisp
@@ -0,0 +1,47 @@
+(defpackage #:machine
+  (:use :cl)
+  (:export :run))
+
+(in-package #:machine)
+
+;;; Interpreter
+
+(defconstant +op-adv+ 0)
+(defconstant +op-bxl+ 1)
+(defconstant +op-bst+ 2)
+(defconstant +op-jnz+ 3)
+(defconstant +op-bxc+ 4)
+(defconstant +op-out+ 5)
+(defconstant +op-bdv+ 6)
+(defconstant +op-cdv+ 7)
+
+(defun run (program A B C)
+  (let ((ip 0)
+        output)
+    (flet ((fetch-oprand (oprand)
+             (case oprand
+               (4 A) (5 B) (6 C)
+               (otherwise oprand)))
+           (xdv (oprand)
+             (floor A (ash 2 (1- oprand)))))
+      (loop while (< ip (length program)) do
+        (let* ((opcode (aref program ip))
+               (oprand-lit (aref program (1+ ip)))
+               (oprand (fetch-oprand oprand-lit)))
+          (ecase opcode
+            (#.+op-bxl+
+             (setq B (logxor B oprand-lit)))
+            (#.+op-bst+
+             (setq B (logand oprand #b111)))
+            (#.+op-jnz+
+             (unless (zerop A)
+               (setq ip (- oprand-lit 2))))
+            (#.+op-bxc+
+             (setq B (logxor B C)))
+            (#.+op-out+
+             (push (logand oprand #b111) output))
+            (#.+op-adv+ (setq A (xdv oprand)))
+            (#.+op-bdv+ (setq B (xdv oprand)))
+            (#.+op-cdv+ (setq C (xdv oprand))))
+          (incf ip 2))))
+    (nreverse output)))
\ No newline at end of file
diff --git a/2024/17/puzzle-1.lisp b/2024/17/puzzle-1.lisp
new file mode 100755
index 0000000..175c9f1
--- /dev/null
+++ b/2024/17/puzzle-1.lisp
@@ -0,0 +1,34 @@
+#!/usr/bin/sbcl --script
+
+(load "machine.lisp")
+
+(defun main (filename)
+  (multiple-value-call #'machine:run (parse filename)))
+
+(defun parse (filename)
+  (with-open-file (stream filename)
+    (let ((contents (make-string (file-length stream))))
+      (read-sequence contents stream)
+      (extract-numbers-from-string contents))))
+
+(defun extract-numbers-from-string (string)
+  (let (numbers)
+    (loop do
+      (let* ((beg (position-if #'digit-char-p string))
+             (end (position-if-not #'digit-char-p string :start (or beg 0))))
+        (unless beg
+          (loop-finish))
+        (push (parse-integer (subseq string beg end)) numbers)
+        (setq string (subseq string (or end (length string))))))
+    (setq numbers (nreverse numbers))
+    (values
+     (coerce (cdddr numbers) 'vector)
+     (first  numbers)
+     (second numbers)
+     (third  numbers))))
+
+(loop with output = (main "input")
+      for number in output
+      for i upfrom 1
+      do (format t "~d~c" number (if (= i (length output))
+                                     #\Newline #\,)))
\ No newline at end of file
diff --git a/2024/17/puzzle-2.py b/2024/17/puzzle-2.py
new file mode 100755
index 0000000..e23e34f
--- /dev/null
+++ b/2024/17/puzzle-2.py
@@ -0,0 +1,33 @@
+#!/usr/bin/python3
+
+def main() -> None:
+	with open("input", "r") as f:
+		prog = [
+			int(x) for x in (
+				next(l for l in f.readlines() if l.startswith("Program"))
+				.split(':' )[1]
+				.split(',')
+			)
+		][::-1]
+	print(search(prog))
+
+
+def step(a: int) -> int:
+	b = (a & 7) ^ 2
+	return (a>>b ^ b ^ 7) & 7
+
+
+def search(prog: list[int], a: int = 0) -> int | None:
+	if len(prog) == 0:
+		return a
+	for i in range(0b111 + 1):
+		n = a<<3 | i
+		if (
+			step(n) == prog[0]
+			and (b := search(prog[1:], n)) is not None
+		):
+			return b
+
+
+if __name__ == "__main__":
+	main()
\ No newline at end of file