From 4f8a43d2e2a29086efc8d00c132d4d7c0eb5675a Mon Sep 17 00:00:00 2001
From: Peter Tillemans <pti@snamellit.com>
Date: Tue, 17 Dec 2024 15:55:20 +0100
Subject: [PATCH] solved day17

---
 aoc.asd                    |   2 +-
 src/2024/day17.lisp        | 243 +++++++++++++++++++++++++++++++++++--
 tests/2024/day17-test.lisp | 179 +++++++++++++++++++++++++--
 3 files changed, 404 insertions(+), 20 deletions(-)

diff --git a/aoc.asd b/aoc.asd
index 756197c..e0a6b95 100644
--- a/aoc.asd
+++ b/aoc.asd
@@ -13,7 +13,7 @@
 	       #:plump
 	       #:lquery
 	       #:3d-vectors
-	       #:array-operationIs
+	       #:array-operations
 	       #:lla
 	       #:queues.simple-queue
 	       #:queues.priority-queue
diff --git a/src/2024/day17.lisp b/src/2024/day17.lisp
index 4550dd4..490fbd5 100644
--- a/src/2024/day17.lisp
+++ b/src/2024/day17.lisp
@@ -1,35 +1,262 @@
 
 (defpackage :aoc/2024/17
-  (:use :cl :aoc :alexandria :trivia :lla)
+  (:use :cl :aoc :alexandria :lla :arrow-macros)
   (:export
    #:sample-data
    #:sample-data2
    #:part1
    #:part2
+   #:literal-operand
+   #:combo-operand
+   #:instruction-cycle
+   #:run-program
+   #:make-cpu
+   #:cpu-a
+   #:cpu-b
+   #:cpu-c
+   #:cpu-ip
+   #:cpu-mem
+   #:cpu-state
+   
+   
+   
    ))
 
 (in-package :aoc/2024/17)
 
 
-(defun parse-line (line)
-  line)
+(defstruct cpu
+  (ip 0)
+  (a 0)
+  (b 0)
+  (c 0)
+  (mem #())
+  (state :running))
 
+(defun cpu-with-ip (cpu ip)
+  (make-cpu
+   :ip ip
+   :a (cpu-a cpu) 
+   :b (cpu-b cpu)
+   :c (cpu-c cpu) 
+   :mem (cpu-mem cpu) 
+   :state (cpu-state cpu)))
+
+(defun cpu-inc-ip (cpu n)
+  (cpu-with-ip cpu (+ (cpu-ip cpu) n)))
+
+(defun cpu-with-a (cpu a)
+  (make-cpu
+   :ip (cpu-ip cpu)
+   :a a
+   :b (cpu-b cpu)
+   :c (cpu-c cpu) 
+   :mem (cpu-mem cpu) 
+   :state (cpu-state cpu)))
+(defun cpu-with-b (cpu b)
+  (make-cpu
+   :ip (cpu-ip cpu)
+   :a (cpu-a cpu) 
+   :b b
+   :c (cpu-c cpu) 
+   :mem (cpu-mem cpu) 
+   :state (cpu-state cpu)))
+(defun cpu-with-c (cpu c)
+  (make-cpu
+   :ip (cpu-ip cpu)
+   :a (cpu-a cpu) 
+   :b (cpu-b cpu)
+   :c c 
+   :mem (cpu-mem cpu) 
+   :state (cpu-state cpu)))
+(defun cpu-with-state (cpu state)
+  (make-cpu
+   :ip (cpu-ip cpu)
+   :a (cpu-a cpu) 
+   :b (cpu-b cpu)
+   :c (cpu-c cpu) 
+   :mem (cpu-mem cpu) 
+   :state state))
+(defun cpu-with-mem (cpu mem)
+  (make-cpu
+   :ip (cpu-ip cpu)
+   :a (cpu-a cpu) 
+   :b (cpu-b cpu)
+   :c (cpu-c cpu) 
+   :mem mem 
+   :state (cpu-state cpu)))
+
+
+(defun parse-line (line)
+  (let ((nums (second (ppcre:split ": " line))))
+    (mapcar #'parse-integer (ppcre:split "," nums)))
+  )
 
 (defun parse-input (lines)
-  (mapcar #'parse-line lines))
+  (let ((a (first (parse-line (nth 0 lines))))
+	(b (first (parse-line (nth 1 lines))))
+	(c (first (parse-line (nth 2 lines))))
+	(program (parse-line (nth 4 lines))))
+    (make-cpu
+     :ip 0
+     :a a
+     :b b
+     :c c
+     :mem (make-array (length program)
+		      :initial-contents program)
+     :state :running)))
 
 (defparameter input-text (test-input 2024 17))
 (defparameter input-data (parse-input input-text))
 
-(defparameter sample-text (aoc:split-lines ""))
+(defparameter sample-text (aoc:split-lines "Register A: 729
+Register B: 0
+Register C: 0
+
+Program: 0,1,5,4,3,0"))
 (defparameter sample-data 
-              (parse-input sample-text))
+  (parse-input sample-text))
+
+
+(defun to-opcode (cpu)
+  (let ((n (aref (cpu-mem cpu) (cpu-ip cpu))))
+    (case n
+      (0 :adv)
+      (1 :bxl)
+      (2 :bst)
+      (3 :jnz)
+      (4 :bxc)
+      (5 :out)
+      (6 :bdv)
+      (7 :cdv))))
+
+(defun literal-operand (cpu)
+  (aref (cpu-mem cpu) (1+ (cpu-ip cpu))))
+
+(defun combo-operand (cpu)
+  (let ((operand (literal-operand cpu)))
+    (ccase operand
+      ((0 1 2 3) operand)
+      (4 (cpu-a cpu))
+      (5 (cpu-b cpu))
+      (6 (cpu-c cpu))
+      (7 :reserved))))
+
+(defun execute-opcode (cpu output)
+  (let ((opcode (to-opcode cpu)))
+    (let ((next (ccase opcode
+		  (:adv (->
+			    (cpu-with-a cpu (ash (cpu-a cpu) (-  (combo-operand cpu))))
+			  (cpu-inc-ip 2)))
+		  (:bxl (->
+			    (cpu-with-b cpu (logxor (cpu-b cpu) (literal-operand cpu)))
+			  (cpu-inc-ip 2)))
+		  (:bst (->
+			    (cpu-with-b cpu (mod (combo-operand cpu) 8))
+			  (cpu-inc-ip 2)))
+		  (:jnz (if (zerop (cpu-a cpu))
+			    (cpu-inc-ip cpu 2)
+			    (cpu-with-ip cpu (literal-operand cpu))))
+		  (:bxc (->
+			    (cpu-with-b cpu (logxor (cpu-b cpu) (cpu-c cpu)))
+			  (cpu-inc-ip 2)))
+		  (:out (progn
+			  (push (mod (combo-operand cpu) 8) output)
+			  (cpu-inc-ip cpu 2)))
+		  (:bdv (->
+			    (cpu-with-b cpu (ash (cpu-a cpu) (- (combo-operand cpu))))
+			  (cpu-inc-ip 2)))
+		  (:cdv (->
+			    (cpu-with-c cpu (ash (cpu-a cpu) (- (combo-operand cpu))))
+			  (cpu-inc-ip 2))))))
+      (values next output))))
+
+(defun instruction-cycle (cpu output)
+  (multiple-value-bind (cpu out)
+      (cond
+	((eq :halted (cpu-state cpu))
+	 (values cpu output))
+	((not (array-in-bounds-p (cpu-mem cpu) (cpu-ip cpu)))
+	 (values (cpu-with-state cpu :halted) output))
+	(t
+	 (execute-opcode cpu output)))
+    (values cpu out))
+  
+  
+  )
+
+(defun run-program (initial &optional (output '()))
+  
+  (loop
+    with values and cpu
+    do (setf (values cpu output) (instruction-cycle (or cpu initial) output))
+    until (eq :halted (cpu-state cpu))
+    finally (return 
+	      (values cpu (reverse output)))))
 
 (defun part1 (data)
-  (length data))
+  (multiple-value-bind (_ out)
+      (run-program data)
+    (format nil "~{~A~^,~}" out)))
+
+
+
+(defun disassemble (cpu)
+  (let ((program (cpu-mem cpu))
+	(cpu (copy-cpu cpu)))
+    (loop
+      for ip from 0 below (array-dimension program 0) by 2
+      do (setf (cpu-ip cpu) ip)
+      do (let ((opcode (to-opcode cpu))
+	       (operand (literal-operand cpu)))
+	   (format t " ~A ~A~%" opcode operand)))))
+
+
+
+
+
+
+;; BST 4   -->   B = A mod 8
+;; BXL 1   -->   B = B xor 1
+;; CDV 5  -->  C = A shr B
+;; BXC 6   -->  B = B xor C
+;; BXL 4   -->   B = B xor 4
+;; ADV 3  -->  A = A shr 3
+;; OUT 5 ---> out B                                 
+;; JNZ 0
+;;
+;; so the loop does not depend on the initial versions of B and C
+;; B can maximally be 7,
+;; we are only interested in the 10 bottom bits of A : 7 + 3
+;; so we can brute force over the 10 lower bits to get at the end of the loop
+;; a given A and output
+;; only the bottom 3 bits of A change
+
+(defun find-a (cpu target-a target-out)
+  (let ((snippet (cpu-with-mem
+		  cpu
+		  (adjust-array
+		   (cpu-mem cpu)
+		   (list (- (array-dimension (cpu-mem cpu) 0) 2)))))
+	)
+    (loop
+      for bot-a from 0 to 7
+      for c = (cpu-with-a snippet (+ (ash target-a 3) bot-a))    
+      until (multiple-value-bind (cpu out)
+		(run-program c '())
+	      (and (= (cpu-a cpu) target-a)
+		   (equal (car out) target-out)))
+      finally (return (+ (ash target-a 3) bot-a)))))
+
+(defun solve-part2 (data)
+  (loop
+    for x in (reverse (coerce (cpu-mem data) 'list))
+    for a = (find-a data (or a 0) x)
+    finally (return a))
+  )
 
 (defun part2 (data)
-  (length data))
+  (format nil "~A" (solve-part2 data)))
 
 (defun solve-day ()
   (format t "part1: ~A~%" (part1 input-data))
diff --git a/tests/2024/day17-test.lisp b/tests/2024/day17-test.lisp
index 0b427a0..923f628 100644
--- a/tests/2024/day17-test.lisp
+++ b/tests/2024/day17-test.lisp
@@ -1,26 +1,183 @@
 (defpackage :aoc/2024/17/tests
-            (:use :cl :aoc :aoc/tests :aoc/2024/tests :parachute :aoc/2024/17))
+  (:use :cl :aoc :aoc/tests :aoc/2024/tests :parachute :aoc/2024/17 :arrow-macros))
 
 (in-package :aoc/2024/17/tests)
 
 (define-test suite-2024-17
                                         ;:parent suite-2024
-             )
+  )
 
-(define-test test-foo
-             :parent suite-2024-17
-             ) 
+(define-test test-adv
+  :parent suite-2024-17
+
+  (multiple-value-bind (cpu out)
+      (instruction-cycle (make-cpu :a 4 :mem #(0 1)) '())
+    (is = 2 (cpu-ip cpu))
+    (is = 2 (cpu-a cpu))
+    (is = 0 (cpu-b cpu))
+    (is = 0 (cpu-c cpu))
+    (is eq :running (cpu-state cpu))
+    (is equal '() out)
+    )
+  (multiple-value-bind (cpu out)
+      (instruction-cycle (make-cpu :a 256 :b 7 :mem #(0 5)) '())
+    (is = 2 (cpu-ip cpu))
+    (is = 2 (cpu-a cpu))
+    (is = 7 (cpu-b cpu))
+    (is = 0 (cpu-c cpu))
+    (is eq :running (cpu-state cpu))
+    (is equal '() out)
+    )
+  )
+
+(define-test test-bxl
+  :parent suite-2024-17
+  (multiple-value-bind (cpu out)
+      (instruction-cycle (make-cpu :b 4 :mem #(1 7)) '())
+    (is = 2 (cpu-ip cpu))
+    (is = 0 (cpu-a cpu))
+    (is = 3 (cpu-b cpu))
+    (is = 0 (cpu-c cpu))
+    (is eq :running (cpu-state cpu))
+    (is equal '() out)
+    ))
+
+(define-test test-bst
+  :parent suite-2024-17
+  (multiple-value-bind (cpu out)
+      (instruction-cycle (make-cpu :b 4 :mem #(2 3)) '())
+    (is = 2 (cpu-ip cpu))
+    (is = 0 (cpu-a cpu))
+    (is = 3 (cpu-b cpu))
+    (is = 0 (cpu-c cpu))
+    (is eq :running (cpu-state cpu))
+    (is equal '() out)
+    )
+  (multiple-value-bind (cpu out)
+      (instruction-cycle (make-cpu :a 89 :b 4 :mem #(2 4)) '())
+    (is = 2 (cpu-ip cpu))
+    (is = 89 (cpu-a cpu))
+    (is = 1 (cpu-b cpu))
+    (is = 0 (cpu-c cpu))
+    (is eq :running (cpu-state cpu))
+    (is equal '() out)
+    )
+  (multiple-value-bind (cpu out)
+      (instruction-cycle (make-cpu :b 13 :mem #(2 5)) '())
+    (is = 2 (cpu-ip cpu))
+    (is = 0 (cpu-a cpu))
+    (is = 5 (cpu-b cpu))
+    (is = 0 (cpu-c cpu))
+    (is eq :running (cpu-state cpu))
+    (is equal '() out)
+    )
+  (multiple-value-bind (cpu out)
+      (instruction-cycle (make-cpu :b 4 :c 69 :mem #(2 6)) '())
+    (is = 2 (cpu-ip cpu))
+    (is = 0 (cpu-a cpu))
+    (is = 5 (cpu-b cpu))
+    (is = 69 (cpu-c cpu))
+    (is eq :running (cpu-state cpu))
+    (is equal '() out)
+    )
+  )
+
+(define-test test-jnz 
+  (multiple-value-bind (cpu out)
+      (instruction-cycle (make-cpu :b 4 :c 69 :mem #(3 69)) '())
+    (is = 2 (cpu-ip cpu))
+    (is = 0 (cpu-a cpu))
+    (is = 5 (cpu-b cpu))
+    (is = 69 (cpu-c cpu))
+    (is eq :running (cpu-state cpu))
+    (is equal '() out)
+    )
+  (multiple-value-bind (cpu out)
+      (instruction-cycle (make-cpu :b 4 :c 69 :mem #(2 6)) '())
+    (is = 2 (cpu-ip cpu))
+    (is = 0 (cpu-a cpu))
+    (is = 5 (cpu-b cpu))
+    (is = 69 (cpu-c cpu))
+    (is eq :running (cpu-state cpu))
+    (is equal '() out)
+    )
+  )
+
+(define-test test-bdv 
+  :parent suite-2024-17
+  (multiple-value-bind (cpu out)
+      (instruction-cycle (make-cpu :a 4 :mem #(6 1)) '())
+    (is = (cpu-ip cpu) 2)
+    (is = (cpu-a cpu) 4)
+    (is = (cpu-b cpu) 2)
+    (is = (cpu-c cpu) 0)
+    (is eq (cpu-state cpu) :running)
+    (is equal out '()))
+  (multiple-value-bind (cpu out)
+      (instruction-cycle (make-cpu :a 256 :b 7 :mem #(6 5)) '())
+    (is = (cpu-ip cpu) 2)
+    (is = (cpu-a cpu) 256)
+    (is = 2 (cpu-b cpu)) 
+    (is = 0 (cpu-c cpu))
+    (is eq (cpu-state cpu) :running)
+    (is equal out '()))
+  )
+
+(define-test tet-cdv 
+  :parent suite-2024-17
+  (multiple-value-bind (cpu out)
+      (instruction-cycle (make-cpu :a 4 :mem #(7 1)) '())
+    (is = 2 (cpu-ip cpu))
+    (is = 4 (cpu-a cpu))
+    (is = 0 (cpu-b cpu))
+    (is = 2 (cpu-c cpu))
+    (is eq :running (cpu-state cpu))
+    (is equal '() out))
+  (multiple-value-bind (cpu out)
+      (instruction-cycle (make-cpu :a 256 :b 7 :mem #(7 5)) '())
+    (is = 2 (cpu-ip cpu))
+    (is = 256 (cpu-a cpu))
+    (is = 7 (cpu-b cpu))
+    (is = 2 (cpu-c cpu))
+    (is eq :running (cpu-state cpu))
+    (is equal '() out))
+  )
 
 
-(define-test test-bar
-             :parent suite-2024-17
-             )
-
 
+(define-test test-cpu
+  :parent suite-2024-17
+  ;; If register C contains 9, the program 2,6 would set register B to 1.
+  (multiple-value-bind (cpu)
+      
+      (instruction-cycle (make-cpu :c 9 :mem #(2 6)) '())
+    (is = 1 (cpu-b cpu)))
+  
+  ;; If register A contains 10, the program 5,0,5,1,5,4 would output 0,1,2
+  (multiple-value-bind (cpu out)
+      (run-program (make-cpu :a 10 :mem #(5 0 5 1 5 4)))
+    (is equal :halted (cpu-state cpu))
+    (is equal '(0 1 2) out))
+  
+  ;; If register A contains 2024, the program 0,1,5,4,3,0 would output 4,2,5,6,7,7,7,7,3,1,0 and leave 0 in register A.
+  (multiple-value-bind (cpu out)
+      (run-program (make-cpu :a 2024 :mem #(0 1 5 4 3 0)))
+    (is = 0 (cpu-a cpu))
+    (is equal '(4 2 5 6 7 7 7 7 3 1 0) out))
+  
+  ;; If register B contains 29, the program 1,7 would set register B to 26.
+  (multiple-value-bind (cpu)
+      (run-program (make-cpu :b 29 :mem #(1 7)))
+    (is = 26 (cpu-b cpu)))
+  
+  ;; If register B contains 2024 and register C contains 43690, the program 4,0 would set register B to 44354.
+  (multiple-value-bind (cpu)
+      (run-program (make-cpu :b 2024 :c 43690 :mem #(4 0)))
+    (is = 44354 (cpu-b cpu)))) 
 
 (define-test+run test-part1
-                 :parent suite-2024-17
-                 (is equal nil (part1 sample-data)))
+  :parent suite-2024-17
+  (is equal "4,6,3,5,6,3,5,2,1,0" (part1 sample-data)))
 
 (define-test+run test-part2
                  :parent suite-2024-17