day 10 part 2 in common lisp

common-lisp/day-10/example.txt

@@ -0,0 +1 @@
+../../input/day-10-example.txt

common-lisp/day-10/input.txt

@@ -0,0 +1 @@
+../../input/day-10.txt

common-lisp/day-10/solution.lisp

@@ -0,0 +1,104 @@
+#!/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:

common-lisp/day-9/example-large.txt

@@ -0,0 +1 @@
+../../input/day-9-example-large.txt

common-lisp/day-9/example.txt

@@ -0,0 +1 @@
+../../input/day-9-example.txt

common-lisp/day-9/input.txt

@@ -0,0 +1 @@
+../../input/day-9.txt

common-lisp/day-9/solution.lisp

@@ -0,0 +1,171 @@
+#!/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 'iterate)
+(require 'str)
+
+(defpackage advent-of-code-day-9
+  (:use :cl :iterate)
+  (:import-from :uiop :if-let))
+
+(in-package :advent-of-code-day-9)
+
+(defclass point ()
+  ((x
+    :initarg :x
+    :reader x)
+   (y
+    :initarg :y
+    :reader y)))
+
+(defun new-point (x y)
+  (make-instance 'point :x x :y y))
+
+(defmethod print-object ((obj point) stream)
+  (print-unreadable-object (obj stream :type t)
+    (format stream "x: ~a, y: ~a" (x obj) (y obj))))
+
+(defun point+ (a b)
+  (new-point
+   (+ (x a) (x b))
+   (+ (y a) (y b))))
+
+(defun point- (a b)
+  (new-point
+   (- (x a) (x b))
+   (- (y a) (y b))))
+
+(defun point= (a b)
+  (and (= (x a) (x b))
+       (= (y a) (y b))))
+
+(defclass rope ()
+  ((knots
+    :initarg :knots
+    :accessor knots)))
+
+(defun new-rope (len)
+  (make-instance 'rope :knots (iter (for x from 1 to len)
+                                    (collect (new-point 0 0)))))
+
+(defun touching? (head tail)
+  (let ((delta (point- head tail)))
+    (and (<= (abs (x delta)) 1)
+         (<= (abs (y delta)) 1))))
+
+(defun aligned-along-y? (head tail)
+  (= (x head) (x tail)))
+
+(defun aligned-along-x? (head tail)
+  (= (y head) (y tail)))
+
+(defun aligned? (head tail)
+  (or (aligned-along-x? head tail)
+      (aligned-along-y? head tail)))
+
+;; Not sure what to name this function, but this is used to move the tail
+;; towards the head when they are not touching but aligned by row or column,
+;; which means we just step once in one direction instead of a diagonal hop.
+
+(defun catch-up-directional (head tail)
+  (let ((delta (point- head tail)))
+    (point+ tail (if (aligned-along-x? head tail)
+                     (if (plusp (x delta))
+                         (new-point 1 0)
+                         (new-point -1 0))
+                     (if (plusp (y delta))
+                         (new-point 0 1)
+                         (new-point 0 -1))))))
+
+(defun catch-up-diagonal (head tail)
+  (let ((delta (point- head tail)))
+    (point+ tail (cond ((and (plusp (x delta)) (plusp (y delta)))
+                        (new-point 1 1))
+                       ((and (minusp (x delta)) (plusp (y delta)))
+                        (new-point -1 1))
+                       ((and (plusp (x delta)) (minusp (y delta)))
+                        (new-point 1 -1))
+                       ((and (minusp (x delta)) (minusp (y delta)))
+                        (new-point -1 -1))))))
+
+(defun catch-up (rope)
+  (iter (for (head . rest) on (knots rope))        
+        (while rest)
+        (for tail = (car rest))        
+        (unless (touching? head tail)          
+          (setf (car rest) (if (aligned? head tail)
+                               (catch-up-directional head tail)
+                               (catch-up-diagonal head tail))))))
+
+(defun move-rope (rope direction)
+  (with-accessors ((knots knots))
+      rope
+    (setf (car knots) (point+ (car knots) (case direction
+                                            (:right (new-point 1 0))
+                                            (:left (new-point -1 0))
+                                            (:up (new-point 0 1))
+                                            (:down (new-point 0 -1))))))
+  (catch-up rope))
+
+(defun parse-input (input)
+  (iter (for line in input)
+        (for parts = (str:split " " line :omit-nulls t))        
+        (for direction = (car parts))
+        (for steps = (parse-integer (cadr parts)))
+        (collect (cons (cond ((string= direction "R")
+                              :right)
+                             ((string= direction "L")
+                              :left)
+                             ((string= direction "U")
+                              :up)
+                             ((string= direction "D")
+                              :down))
+                       steps))))
+
+(defun solution (input rope-length)
+  (iter (with rope = (new-rope rope-length))
+        (with moves = (parse-input input))
+        (with history = nil)
+        (for (direction . count) in moves)
+        (iter (repeat count)
+              (move-rope rope direction)
+              (for tail = (car (last (knots rope))))
+              (unless (find tail history :test 'point=)
+                (push tail history)))
+        (finally (return (length history)))))
+
+(defun debug-print (&key stream width height rope)
+  (iter (for y from height downto 0)
+        (iter (for x from 0 to width)
+              (for current-point = (new-point x y))                           
+              (for position = (position current-point (knots rope) :test 'point=))
+              (if position
+                  (format stream "~a " position)
+                  (format stream "* ")))
+        (format stream "~%")
+        (finally (format stream "~%"))))
+
+(assert (= 13 (solution (uiop:read-file-lines "example.txt") 2)))
+(assert (= 6044 (solution (uiop:read-file-lines "input.txt") 2)))
+(assert (= 1 (solution (uiop:read-file-lines "example.txt") 10)))
+(assert (= 36 (solution (uiop:read-file-lines "example-large.txt") 10)))
+(assert (= 2384 (solution (uiop:read-file-lines "input.txt") 10)))
+
+;; Local Variables:
+;; mode: lisp
+;; End:

input/day-10-example.txt

@@ -0,0 +1,146 @@
+addx 15
+addx -11
+addx 6
+addx -3
+addx 5
+addx -1
+addx -8
+addx 13
+addx 4
+noop
+addx -1
+addx 5
+addx -1
+addx 5
+addx -1
+addx 5
+addx -1
+addx 5
+addx -1
+addx -35
+addx 1
+addx 24
+addx -19
+addx 1
+addx 16
+addx -11
+noop
+noop
+addx 21
+addx -15
+noop
+noop
+addx -3
+addx 9
+addx 1
+addx -3
+addx 8
+addx 1
+addx 5
+noop
+noop
+noop
+noop
+noop
+addx -36
+noop
+addx 1
+addx 7
+noop
+noop
+noop
+addx 2
+addx 6
+noop
+noop
+noop
+noop
+noop
+addx 1
+noop
+noop
+addx 7
+addx 1
+noop
+addx -13
+addx 13
+addx 7
+noop
+addx 1
+addx -33
+noop
+noop
+noop
+addx 2
+noop
+noop
+noop
+addx 8
+noop
+addx -1
+addx 2
+addx 1
+noop
+addx 17
+addx -9
+addx 1
+addx 1
+addx -3
+addx 11
+noop
+noop
+addx 1
+noop
+addx 1
+noop
+noop
+addx -13
+addx -19
+addx 1
+addx 3
+addx 26
+addx -30
+addx 12
+addx -1
+addx 3
+addx 1
+noop
+noop
+noop
+addx -9
+addx 18
+addx 1
+addx 2
+noop
+noop
+addx 9
+noop
+noop
+noop
+addx -1
+addx 2
+addx -37
+addx 1
+addx 3
+noop
+addx 15
+addx -21
+addx 22
+addx -6
+addx 1
+noop
+addx 2
+addx 1
+noop
+addx -10
+noop
+noop
+addx 20
+addx 1
+addx 2
+addx 2
+addx -6
+addx -11
+noop
+noop
+noop

input/day-10.txt

@@ -0,0 +1,145 @@
+noop
+noop
+noop
+addx 6
+noop
+addx 30
+addx -26
+noop
+addx 5
+noop
+noop
+noop
+noop
+addx 5
+addx -5
+addx 6
+addx 5
+addx -1
+addx 5
+noop
+noop
+addx -14
+addx -18
+addx 39
+addx -39
+addx 25
+addx -22
+addx 2
+addx 5
+addx 2
+addx 3
+addx -2
+addx 2
+noop
+addx 3
+addx 2
+addx 2
+noop
+addx 3
+noop
+addx 3
+addx 2
+addx 5
+addx 4
+addx -18
+addx 17
+addx -38
+addx 5
+addx 2
+addx -5
+addx 27
+addx -19
+noop
+addx 3
+addx 4
+noop
+noop
+addx 5
+addx -1
+noop
+noop
+addx 4
+addx 5
+addx 2
+addx -4
+addx 5
+noop
+addx -11
+addx 16
+addx -36
+noop
+addx 5
+noop
+addx 28
+addx -23
+noop
+noop
+noop
+addx 21
+addx -18
+noop
+addx 3
+addx 2
+addx 2
+addx 5
+addx 1
+noop
+noop
+addx 4
+noop
+noop
+noop
+noop
+noop
+addx 8
+addx -40
+noop
+addx 7
+noop
+addx -2
+addx 5
+addx 2
+addx 25
+addx -31
+addx 9
+addx 5
+addx 2
+addx 2
+addx 3
+addx -2
+noop
+addx 3
+addx 2
+noop
+addx 7
+addx -2
+addx 5
+addx -40
+addx 20
+addx -12
+noop
+noop
+noop
+addx -5
+addx 7
+addx 7
+noop
+addx -1
+addx 1
+addx 5
+addx 3
+addx -2
+addx 2
+noop
+addx 3
+addx 2
+noop
+noop
+noop
+noop
+addx 7
+noop
+noop
+noop
+noop

input/day-9-example-large.txt

@@ -0,0 +1,8 @@
+R 5
+U 8
+L 8
+D 3
+R 17
+D 10
+L 25
+U 20

input/day-9-example.txt

@@ -0,0 +1,8 @@
+R 4
+U 4
+L 3
+D 1
+R 4
+D 1
+L 5
+R 2