| 1 | (asdf:load-system :adventofcode2020) |
| 2 | (in-package #:adventofcode2020) |
| 3 | (named-readtables:in-readtable fn-reader) |
| 4 | |
| 5 | (defun make-program (insts) |
| 6 | (let ((len (length insts)) |
| 7 | (parse-inst (lambda (inst) |
| 8 | (cl-ppcre:register-groups-bind |
| 9 | (code (#'parse-integer imm)) |
| 10 | ("([a-z]{3}) ([-+][0-9]+)" inst) |
| 11 | (list code imm))))) |
| 12 | (list |
| 13 | :ptr 0 |
| 14 | :acc 0 |
| 15 | :mem (make-array len :initial-contents (mapcar parse-inst insts)) |
| 16 | :vis (make-array len :element-type 'bit)))) |
| 17 | |
| 18 | (defun step-program (program) |
| 19 | (let ((ptr (getf program :ptr)) |
| 20 | (mem (getf program :mem)) |
| 21 | (acc (getf program :acc))) |
| 22 | (if (= ptr (length mem)) |
| 23 | (setf (getf program :stop) 1) |
| 24 | (if (= 1 (bit (getf program :vis) ptr)) |
| 25 | (setf (getf program :stop) 2) |
| 26 | (destructuring-bind (code imm) (aref mem ptr) |
| 27 | (cond ((string= code "nop") |
| 28 | (setf (getf program :ptr) (1+ ptr))) |
| 29 | ((string= code "acc") |
| 30 | (progn |
| 31 | (setf (getf program :ptr) (1+ ptr)) |
| 32 | (setf (getf program :acc) (+ acc imm)))) |
| 33 | ((string= code "jmp") |
| 34 | (setf (getf program :ptr) (+ ptr imm)))) |
| 35 | (setf (bit (getf program :vis) ptr) 1)))) |
| 36 | program)) |
| 37 | |
| 38 | (defun run-until-stop (program) |
| 39 | (if (getf program :stop) |
| 40 | (values (getf program :acc) (getf program :stop)) |
| 41 | (run-until-stop (step-program program)))) |
| 42 | |
| 43 | (defun run-with-fix (program i) |
| 44 | (let ((fixing (aref (getf program :mem) i)) |
| 45 | (fix-code (lambda (inst) |
| 46 | (destructuring-bind (code imm) inst |
| 47 | (cond ((string= code "nop") (list "jmp" imm)) |
| 48 | ((string= code "jmp") (list "nop" imm))))))) |
| 49 | (setf (aref (getf program :mem) i) (funcall fix-code fixing)) |
| 50 | (multiple-value-bind (acc stop) (run-until-stop program) |
| 51 | (setf (aref (getf program :mem) i) fixing) |
| 52 | (setf (getf program :stop) nil) |
| 53 | (setf (getf program :ptr) 0) |
| 54 | (setf (getf program :acc) 0) |
| 55 | (setf (getf program :vis) (make-array (length (getf program :mem)) :element-type 'bit)) |
| 56 | (if (= stop 1) |
| 57 | acc |
| 58 | most-negative-fixnum)))) |
| 59 | |
| 60 | (defun find-fixed-result (program) |
| 61 | (loop for i from 0 below (length (getf program :mem)) |
| 62 | unless (string= "acc" (first (aref (getf program :mem) i))) |
| 63 | maximizing (run-with-fix program i))) |
| 64 | |
| 65 | (day 08 input |
| 66 | (let ((program (make-program (list-from input)))) |
| 67 | (part1 (run-until-stop program)) |
| 68 | (part2 (find-fixed-result program)))) |
| 69 | |
| 70 | (def-suite day08) |
| 71 | (in-suite day08) |
| 72 | |
| 73 | (defvar *simple-instructions* |
| 74 | '("nop +0" |
| 75 | "acc +1" |
| 76 | "jmp +4" |
| 77 | "acc +3" |
| 78 | "jmp -3" |
| 79 | "acc -99" |
| 80 | "acc +1" |
| 81 | "jmp -4" |
| 82 | "acc +6")) |
| 83 | |
| 84 | (test run-until-stop |
| 85 | (is (equal |
| 86 | 5 |
| 87 | (run-until-stop (make-program *simple-instructions*))))) |
| 88 | |
| 89 | (test run-with-fix |
| 90 | (is (equal |
| 91 | 8 |
| 92 | (run-with-fix (make-program *simple-instructions*) 7)))) |
| 93 | |
| 94 | (test find-fixed-result |
| 95 | (is (equal |
| 96 | 8 |
| 97 | (find-fixed-result (make-program *simple-instructions*))))) |
| 98 | |
| 99 | (run! 'day08) |