day 9 in common lisp

This commit is contained in:
cow 2022-12-27 04:16:14 -05:00
parent aa0ce6586b
commit 826b0b10ad
7 changed files with 2190 additions and 0 deletions

View file

@ -0,0 +1 @@
../../input/day-9-example-large.txt

View file

@ -0,0 +1 @@
../../input/day-9-example.txt

1
common-lisp/day-9/input.txt Symbolic link
View file

@ -0,0 +1 @@
../../input/day-9.txt

171
common-lisp/day-9/solution.lisp Executable file
View file

@ -0,0 +1,171 @@
#!/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:

View file

@ -0,0 +1,8 @@
R 5
U 8
L 8
D 3
R 17
D 10
L 25
U 20

8
input/day-9-example.txt Normal file
View file

@ -0,0 +1,8 @@
R 4
U 4
L 3
D 1
R 4
D 1
L 5
R 2

2000
input/day-9.txt Normal file

File diff suppressed because it is too large Load diff