aoc-2022/common-lisp/day-10/solution.lisp

#!/usr/bin/env -S sbcl --script

;; Copyright (C) 2022
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

(require 'asdf)
(require 'uiop)
(require 'str)
(require 'iterate)

(defpackage :advent-of-code-day-10
  (:use :cl :iterate)
  (:import-from :uiop :read-file-lines))

(in-package :advent-of-code-day-10)

(defun register-value-at-cycle (instructions cycle)
  (iter (for instruction in instructions)
        (for noop? = (not (consp instruction)))
        (for counter initially 1 then (+ counter (if noop? 1 2)))
        (for register initially 1 then (if noop? register (+ register (cdr instruction))))        
        (for previous-register-value previous register)                
        (when (> counter cycle)
          (return (if (first-iteration-p)
                      1
                      previous-register-value)))
        (finally (return register))))

(defun signal-strength-at-cycle (instructions cycle)
  (* (register-value-at-cycle instructions cycle) cycle))

(defun sprite-intersects? (pixel sprite)
  (let ((sprite-start (- sprite 1))
        (sprite-end (+ sprite 1)))
    (and (>= pixel sprite-start)
         (<= pixel sprite-end))))

(defun parse-input (lines)
  (iter (for line in lines)
        (collect (if (string= line "noop")
                     :noop
                     (cons :addx (parse-integer (cadr (str:split " " line))))))))

(defun solution-part-2 (instructions)
  (iter (with screen = (make-array '(6 40) :element-type 'character :initial-element #\.))
        (for cycle from 1 to 240)
        (for register = (register-value-at-cycle instructions cycle))        
        (for x = (mod (- cycle 1) 40))
        (for (values y nil) = (floor (- cycle 1) 40))        
        (when (sprite-intersects? x register)
          (setf (aref screen y x) #\#))
        (finally (return screen))))

(defun print-screen (screen stream)
  (iter (for y from 0 to 5)
        (iter (for x from 0 to 39)
              (format stream "~a" (aref screen y x)))
        (format stream "~%")))


;; test cases

(let ((input (parse-input (read-file-lines "example.txt"))))
  (assert (= 420 (signal-strength-at-cycle input 20)))
  (assert (= 1140 (signal-strength-at-cycle input 60)))
  (assert (= 1800 (signal-strength-at-cycle input 100)))
  (assert (= 2940 (signal-strength-at-cycle input 140)))
  (assert (= 2880 (signal-strength-at-cycle input 180)))
  (assert (= 3960 (signal-strength-at-cycle input 220)))
  (assert (= 13140 (iter (for cycle from 20 to 220 by 40)
                         (sum (signal-strength-at-cycle input cycle))))))

(let ((input (parse-input (read-file-lines "input.txt"))))
  (assert (= 14320 (iter (for cycle from 20 to 240 by 40)
                         (sum (signal-strength-at-cycle input cycle))))))


;; this puzzle relies on visual confirmation to determine whether its correct or not
;; so we just print the result to the terminal

(let* ((input (parse-input (read-file-lines "example.txt")))
       (screen (solution-part-2 input)))
  (format t "~&~%screen for example input~%~%")
  (print-screen screen t))

(let* ((input (parse-input (read-file-lines "input.txt")))
       (screen (solution-part-2 input)))
  (format t "~&~%screen for normal input~%~%")
  (print-screen screen t))

;; Local Variables:
;; mode: lisp
;; End: