1 files changed, 78 insertions, 62 deletions
diff --git a/2022/puzzle-9.lisp b/2022/puzzle-9.lisp
index d27234b..e468627 100644
--- a/2022/puzzle-9.lisp
+++ b/2022/puzzle-9.lisp
@@ -1,7 +1,11 @@
 (load "lib")
+
 (defparameter input (uiop:read-file-string "9-input"))
 (defparameter lines (get-lines input))
 
+(defun coords-eq? (x y)
+  (and (= (car x) (car y)) (= (cdr x) (cdr y))))
+
 (defun move (P X Y)
   (cons (+ (car P) X) (+ (cdr P) Y)))
 
@@ -13,73 +17,85 @@
 (defun update-tail (TAIL HEAD)
   (let ((xd (- (car HEAD) (car TAIL)))
         (yd (- (cdr HEAD) (cdr TAIL))))
-    (if (and (<= (abs xd) 1) (<= (abs yd) 1))
-        ;; Leave as is
-        TAIL
-        (cond
-          ;; Diagonal movements
-          ((and (= 1 (abs xd)) (= 2 (abs yd)))
-           (move TAIL xd (-1unit yd)))
-          ((and (= 1 (abs yd)) (= 2 (abs xd)))
-           (move TAIL (-1unit xd) yd))
-          ;; Linear movements on an axis
-          ((= (abs xd) 2)
-           (move TAIL (-1unit xd) 0))
-          ((= (abs yd) 2)
-           (move TAIL 0 (-1unit yd)))))))
-
-(defun move-direction (direction P)
-  (case direction
-    (R (move P 1 0))
-    (L (move P -1 0))
-    (U (move P 0 1))
-    (D (move P 0 -1))))
-
-(defun print-grid (head tail)
-  (destructuring-bind (hx . hy) head
-    (destructuring-bind (tx . ty) tail
-      (loop for x from 0 to 6
-            do
-               (format t "-"))
-      (format t "~%")
-      (loop for y from 6 downto 0
-            do
-               (progn
-                 (format t "~d: " y)
-                 (loop for x from 0 to 6
-                       do
-                          (format t "~s"
-                                  (cond
-                                    ((and (= hx x) (= hy y)) 'H)
-                                    ((and (= tx x) (= ty y)) 'T)
-                                    (t '-))))
-                 (format t "~%"))))))
+    (cond
+      ;; Still touching
+      ((and (<= (abs xd) 1) (<= (abs yd) 1)) TAIL)
+      ;; These do the diagonal one steps
+      ((and (= 1 (abs xd)) (= 2 (abs yd)))
+       (move TAIL xd (-1unit yd)))
+      ((and (= 1 (abs yd)) (= 2 (abs xd)))
+       (move TAIL (-1unit xd) yd))
+      ;; Do the diagonal 2 steps (may happen on round 2)
+      ((and (= 2 (abs xd)) (= 2 (abs yd)))
+       (move TAIL (-1unit xd) (-1unit yd)))
+      ;; Linear movements on an axis
+      ((= (abs xd) 2)
+       (move TAIL (-1unit xd) 0))
+      ((= (abs yd) 2)
+       (move TAIL 0 (-1unit yd))))))
 
 (defun parse-line (line)
   (cons (intern (subseq line 0 1))
         (parse-integer (subseq line 2))))
 
-(defun coords-eq? (x y)
-  (and (= (car x) (car y)) (= (cdr x) (cdr y))))
+(defun move-direction (direction point)
+  (case direction
+    (R (move point 1 0))
+    (U (move point 0 1))
+    (L (move point -1 0))
+    (D (move point 0 -1))))
 
-(defun single-knot-execute-line (line head tail points)
-  (destructuring-bind (direction . magnitude) (parse-line line)
-    (dotimes (x magnitude)
-      (setq head (move-direction direction head))
-      (setq tail (update-tail tail head))
-      (setq points (adjoin tail points :test #'coords-eq?))))
-  (values head tail points))
+(let nil
+  (defun execute-line (line head tail points)
+    (destructuring-bind (direction . magnitude) (parse-line line)
+      (dotimes (x magnitude)
+        (setq head (move-direction direction head))
+        (setq tail (update-tail tail head))
+        (setq points (adjoin tail points :test #'coords-eq?))))
+    (values head tail points))
 
-(defun single-knot-execute-lines (lines &optional head tail points)
-  (if (null lines)
-      (values
-       head tail points)
-      (let ((line (car lines))
-            (head (or head `(0 . 0)))
-            (tail (or tail `(0 . 0)))
-            (points (or points nil)))
-        (multiple-value-bind (head tail points) (single-knot-execute-line line head tail points)
-          (single-knot-execute-lines (cdr lines) head tail points)))))
+  (defun execute-lines (lines &optional head tail points)
+    (if (null lines)
+        (values
+         head tail points)
+        (let ((line (car lines))
+              (head (or head `(0 . 0)))
+              (tail (or tail `(0 . 0)))
+              (points (or points nil)))
+          (multiple-value-bind (head tail points) (execute-line line head tail points)
+            (execute-lines (cdr lines) head tail points)))))
 
-(format t "round 1: ~s~%"
-        (length (car (last (multiple-value-list (single-knot-execute-lines lines))))))
+  (format t "round 1: ~s~%"
+          (length (car (last (multiple-value-list (execute-lines lines)))))))
+
+(let nil
+  (defun update-knots (head knots)
+    (let ((new-knots (list (update-tail (car knots) head))))
+      (loop for knot in (cdr knots)
+            do
+               (setq new-knots (cons (update-tail knot (car new-knots)) new-knots)))
+      new-knots))
+
+  (defun execute-line (line head knots points)
+    (destructuring-bind (direction . magnitude) (parse-line line)
+      (dotimes (x magnitude)
+        (setq head (move-direction direction head))
+        (setq knots (update-knots head knots))
+        (setq points (adjoin (car knots) points :test #'coords-eq?))
+        (setq knots (reverse knots))))
+    (values head knots points))
+
+  (defun execute-lines (lines)
+    (let ((head `(0 . 0))
+          (knots (loop for x from 1 to 9 collect `(0 . 0)))
+          (points nil))
+      (loop for line in lines
+            do
+               (multiple-value-bind (nhead nknots npoints)
+                   (execute-line line head knots points)
+                 (setq head nhead
+                       knots nknots
+                       points npoints)))
+      (values
+       head knots points)))
+  (format t "Round 2: ~a~%" (length (car (last (multiple-value-list (execute-lines lines)))))))