day08.lisp

   1 (asdf:load-system :adventofcode2020)
   2 (in-package #:adventofcode2020)
   3 (named-readtables:in-readtable :adventofcode2020)
   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)