aoc-2022/common-lisp/day-9/solution.lisp

#!/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: