|
|
|
|
@ -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:
|
cow