aboutsummaryrefslogtreecommitdiff
path: root/2022
diff options
context:
space:
mode:
authorAryadev Chavali <aryadev@aryadevchavali.com>2023-10-21 04:25:23 +0100
committerAryadev Chavali <aryadev@aryadevchavali.com>2023-10-21 04:25:23 +0100
commite5c805a17a2df715bd5c4ec4cda1bbb2aa5ad4db (patch)
tree1da631930e372d24d460e546cd9ba889d2d2a6af /2022
parentb99cda70877d5d2aeefb3cc3fdaa3b60a9755059 (diff)
downloadadvent-of-code-e5c805a17a2df715bd5c4ec4cda1bbb2aa5ad4db.tar.gz
advent-of-code-e5c805a17a2df715bd5c4ec4cda1bbb2aa5ad4db.tar.bz2
advent-of-code-e5c805a17a2df715bd5c4ec4cda1bbb2aa5ad4db.zip
Finished round 2 of puzzle 9
Annoying bug that took ages to fix: for multi-execute, there may be times where movements go in complete diagonals. In this case, we need to move in the unit vector diagonal direction. So I modified update-tail for this case. Never happens in round 1 lol.
Diffstat (limited to '2022')
-rw-r--r--2022/puzzle-9.lisp140
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)))))))