weird annoying bug

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,178 @@
+#!/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)))
+
+(defmacro 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)
+  (= (x a) (x b) (y a) (y b)))
+
+(defclass rope ()
+  ((head
+    :initarg :head
+    :accessor head)
+   (tail
+    :initarg :tail
+    :accessor tail)))
+
+(defmacro new-rope (head tail)
+  `(make-instance 'rope :head ,head :tail ,tail))
+
+(defmethod print-object ((obj rope) stream)
+  (print-unreadable-object (obj stream :type t)
+    (format stream "head: ~a, tail: ~a" (head obj) (tail obj))))
+
+(defun touching? (rope)
+  (let ((delta (point- (head rope) (tail rope))))
+    (and (<= (abs (x delta)) 1)
+         (<= (abs (y delta)) 1))))
+
+(defun aligned-along-y? (rope)
+  (= (x (head rope)) (x (tail rope))))
+
+(defun aligned-along-x? (rope)
+  (= (y (head rope)) (y (tail rope))))
+
+(defun aligned? (rope)
+  (or (aligned-along-x? rope)
+      (aligned-along-y? rope)))
+
+
+;; 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 (rope)
+  (let ((delta (point- (head rope) (tail rope))))
+    (setf (tail rope) (point+ (tail rope) (if (aligned-along-x? rope)
+                                              (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 (rope)
+  (let ((delta (point- (head rope) (tail rope))))
+    (setf (tail rope) (point+ (tail rope) (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)
+  (with-accessors ((head head)
+                   (tail tail)
+                   (history history))
+      rope
+    (unless (touching? rope)
+      (if (aligned? rope)
+          (catch-up-directional rope)
+          (catch-up-diagonal rope)))))
+
+(defun process-move (rope direction)
+  (setf (head rope) (point+ (head rope) (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-part-1 (input)
+  (let ((rope (new-rope (new-point 0 0) (new-point 0 0)))
+        (moves (parse-input input))
+        (history (list (new-point 0 0))))
+    (iter (for (direction . count) in moves)                   
+          (iter (for x from 0 to count)
+                (process-move rope direction)
+                (debug-print rope t)
+                (unless (find (tail rope) history :test 'point=)
+                  (push (tail rope) history)))
+          (finally (return history)))))
+
+(defun debug-print (rope stream)
+  (format stream "~A~%" (tail rope))
+  (iter (for y from 0 to 5)        
+        (iter (for x from 0 to 6)              
+              (cond ((point= (head rope) (new-point x y))
+                     (format stream "H "))
+                    ((point= (tail rope) (new-point x y))
+                     (format stream "T "))
+                    (t
+                     (format stream "* ")))
+              (finally (format stream "~%")))
+        (finally (format stream "~%"))))
+
+(assert (touching? (new-rope (new-point 5 5) (new-point 4 4))))
+(assert (not (touching? (new-rope (new-point 5 5) (new-point 4 3)))))
+(assert (aligned? (new-rope (new-point 1 0) (new-point 2 0))))
+
+(solution-part-1 (uiop:read-file-lines "example.txt"))
+
+;; Local Variables:
+;; mode: lisp
+;; End:

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