cow/aoc-2022
2
1
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Compare commits

base: cow:master
Branches Tags
cow:master
cow:day-9-common-lisp
..
compare: cow:day-9-common-lisp
Branches Tags
cow:master
cow:day-9-common-lisp

1 commit
master ... day-9-comm

Author SHA1 Message Date
cow ea6c5c0d10 weird annoying bug 2022-12-27 04:16:14 -05:00
8 changed files with 85 additions and 484 deletions
Show stats Expand all files Collapse all files

1
common-lisp/day-10/example.txt
View file

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

1
common-lisp/day-10/input.txt
View file

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

104
common-lisp/day-10/solution.lisp
View file

@ -1,104 +0,0 @@
#!/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 'str)
(require 'iterate)
(defpackage :advent-of-code-day-10
(:use :cl :iterate)
(:import-from :uiop :read-file-lines))
(in-package :advent-of-code-day-10)
(defun register-value-at-cycle (instructions cycle)
(iter (for instruction in instructions)
(for noop? = (not (consp instruction)))
(for counter initially 1 then (+ counter (if noop? 1 2)))
(for register initially 1 then (if noop? register (+ register (cdr instruction))))
(for previous-register-value previous register)
(when (> counter cycle)
(return (if (first-iteration-p)
1
previous-register-value)))
(finally (return register))))
(defun signal-strength-at-cycle (instructions cycle)
(* (register-value-at-cycle instructions cycle) cycle))
(defun sprite-intersects? (pixel sprite)
(let ((sprite-start (- sprite 1))
(sprite-end (+ sprite 1)))
(and (>= pixel sprite-start)
(<= pixel sprite-end))))
(defun parse-input (lines)
(iter (for line in lines)
(collect (if (string= line "noop")
:noop
(cons :addx (parse-integer (cadr (str:split " " line))))))))
(defun solution-part-2 (instructions)
(iter (with screen = (make-array '(6 40) :element-type 'character :initial-element #\.))
(for cycle from 1 to 240)
(for register = (register-value-at-cycle instructions cycle))
(for x = (mod (- cycle 1) 40))
(for (values y nil) = (floor (- cycle 1) 40))
(when (sprite-intersects? x register)
(setf (aref screen y x) #\#))
(finally (return screen))))
(defun print-screen (screen stream)
(iter (for y from 0 to 5)
(iter (for x from 0 to 39)
(format stream "~a" (aref screen y x)))
(format stream "~%")))
;; test cases
(let ((input (parse-input (read-file-lines "example.txt"))))
(assert (= 420 (signal-strength-at-cycle input 20)))
(assert (= 1140 (signal-strength-at-cycle input 60)))
(assert (= 1800 (signal-strength-at-cycle input 100)))
(assert (= 2940 (signal-strength-at-cycle input 140)))
(assert (= 2880 (signal-strength-at-cycle input 180)))
(assert (= 3960 (signal-strength-at-cycle input 220)))
(assert (= 13140 (iter (for cycle from 20 to 220 by 40)
(sum (signal-strength-at-cycle input cycle))))))
(let ((input (parse-input (read-file-lines "input.txt"))))
(assert (= 14320 (iter (for cycle from 20 to 240 by 40)
(sum (signal-strength-at-cycle input cycle))))))
;; this puzzle relies on visual confirmation to determine whether its correct or not
;; so we just print the result to the terminal
(let* ((input (parse-input (read-file-lines "example.txt")))
(screen (solution-part-2 input)))
(format t "~&~%screen for example input~%~%")
(print-screen screen t))
(let* ((input (parse-input (read-file-lines "input.txt")))
(screen (solution-part-2 input)))
(format t "~&~%screen for normal input~%~%")
(print-screen screen t))
;; Local Variables:
;; mode: lisp
;; End:

1
common-lisp/day-9/example-large.txt
View file

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

163
common-lisp/day-9/solution.lisp
View file

@ -33,8 +33,8 @@
:initarg :y :initarg :y
:reader y))) :reader y)))
(defun new-point (x y) (defmacro new-point (x y)
(make-instance 'point :x x :y y)) `(make-instance 'point :x ,x :y ,y))
(defmethod print-object ((obj point) stream) (defmethod print-object ((obj point) stream)
(print-unreadable-object (obj stream :type t) (print-unreadable-object (obj stream :type t)
@ -51,75 +51,80 @@
(- (y a) (y b)))) (- (y a) (y b))))
(defun point= (a b) (defun point= (a b)
(and (= (x a) (x b)) (= (x a) (x b) (y a) (y b)))
(= (y a) (y b))))
(defclass rope () (defclass rope ()
((knots ((head
:initarg :knots :initarg :head
:accessor knots))) :accessor head)
(tail
:initarg :tail
:accessor tail)))
(defun new-rope (len) (defmacro new-rope (head tail)
(make-instance 'rope :knots (iter (for x from 1 to len) `(make-instance 'rope :head ,head :tail ,tail))
(collect (new-point 0 0)))))
(defun touching? (head tail) (defmethod print-object ((obj rope) stream)
(let ((delta (point- head tail))) (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) (and (<= (abs (x delta)) 1)
(<= (abs (y delta)) 1)))) (<= (abs (y delta)) 1))))
(defun aligned-along-y? (head tail) (defun aligned-along-y? (rope)
(= (x head) (x tail))) (= (x (head rope)) (x (tail rope))))
(defun aligned-along-x? (head tail) (defun aligned-along-x? (rope)
(= (y head) (y tail))) (= (y (head rope)) (y (tail rope))))
(defun aligned? (rope)
(or (aligned-along-x? rope)
(aligned-along-y? rope)))
(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 ;; 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, ;; 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. ;; which means we just step once in one direction instead of a diagonal hop.
(defun catch-up-directional (head tail) (defun catch-up-directional (rope)
(let ((delta (point- head tail))) (let ((delta (point- (head rope) (tail rope))))
(point+ tail (if (aligned-along-x? head tail) (setf (tail rope) (point+ (tail rope) (if (aligned-along-x? rope)
(if (plusp (x delta)) (if (plusp (x delta))
(new-point 1 0) (new-point 1 0)
(new-point -1 0)) (new-point -1 0))
(if (plusp (y delta)) (if (plusp (y delta))
(new-point 0 1) (new-point 0 1)
(new-point 0 -1)))))) (new-point 0 -1)))))))
(defun catch-up-diagonal (head tail) (defun catch-up-diagonal (rope)
(let ((delta (point- head tail))) (let ((delta (point- (head rope) (tail rope))))
(point+ tail (cond ((and (plusp (x delta)) (plusp (y delta))) (setf (tail rope) (point+ (tail rope) (cond ((and (plusp (x delta)) (plusp (y delta)))
(new-point 1 1)) (new-point 1 1))
((and (minusp (x delta)) (plusp (y delta))) ((and (minusp (x delta)) (plusp (y delta)))
(new-point -1 1)) (new-point -1 1))
((and (plusp (x delta)) (minusp (y delta))) ((and (plusp (x delta)) (minusp (y delta)))
(new-point 1 -1)) (new-point 1 -1))
((and (minusp (x delta)) (minusp (y delta))) ((and (minusp (x delta)) (minusp (y delta)))
(new-point -1 -1)))))) (new-point -1 -1)))))))
(defun catch-up (rope) (defun catch-up (rope)
(iter (for (head . rest) on (knots rope)) (with-accessors ((head head)
(while rest) (tail tail)
(for tail = (car rest)) (history history))
(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 rope
(setf (car knots) (point+ (car knots) (case direction (unless (touching? rope)
(:right (new-point 1 0)) (if (aligned? rope)
(:left (new-point -1 0)) (catch-up-directional rope)
(:up (new-point 0 1)) (catch-up-diagonal rope)))))
(:down (new-point 0 -1))))))
(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)) (catch-up rope))
(defun parse-input (input) (defun parse-input (input)
@ -137,34 +142,36 @@
:down)) :down))
steps)))) steps))))
(defun solution (input rope-length) (defun solution-part-1 (input)
(iter (with rope = (new-rope rope-length)) (let ((rope (new-rope (new-point 0 0) (new-point 0 0)))
(with moves = (parse-input input)) (moves (parse-input input))
(with history = nil) (history (list (new-point 0 0))))
(for (direction . count) in moves) (iter (for (direction . count) in moves)
(iter (repeat count) (iter (for x from 0 to count)
(move-rope rope direction) (process-move rope direction)
(for tail = (car (last (knots rope)))) (debug-print rope t)
(unless (find tail history :test 'point=) (unless (find (tail rope) history :test 'point=)
(push tail history))) (push (tail rope) history)))
(finally (return (length history))))) (finally (return history)))))
(defun debug-print (&key stream width height rope) (defun debug-print (rope stream)
(iter (for y from height downto 0) (format stream "~A~%" (tail rope))
(iter (for x from 0 to width) (iter (for y from 0 to 5)
(for current-point = (new-point x y)) (iter (for x from 0 to 6)
(for position = (position current-point (knots rope) :test 'point=)) (cond ((point= (head rope) (new-point x y))
(if position (format stream "H "))
(format stream "~a " position) ((point= (tail rope) (new-point x y))
(format stream "* "))) (format stream "T "))
(format stream "~%") (t
(format stream "* ")))
(finally (format stream "~%")))
(finally (format stream "~%")))) (finally (format stream "~%"))))
(assert (= 13 (solution (uiop:read-file-lines "example.txt") 2))) (assert (touching? (new-rope (new-point 5 5) (new-point 4 4))))
(assert (= 6044 (solution (uiop:read-file-lines "input.txt") 2))) (assert (not (touching? (new-rope (new-point 5 5) (new-point 4 3)))))
(assert (= 1 (solution (uiop:read-file-lines "example.txt") 10))) (assert (aligned? (new-rope (new-point 1 0) (new-point 2 0))))
(assert (= 36 (solution (uiop:read-file-lines "example-large.txt") 10)))
(assert (= 2384 (solution (uiop:read-file-lines "input.txt") 10))) (solution-part-1 (uiop:read-file-lines "example.txt"))
;; Local Variables: ;; Local Variables:
;; mode: lisp ;; mode: lisp

146
input/day-10-example.txt
View file

@ -1,146 +0,0 @@
addx 15
addx -11
addx 6
addx -3
addx 5
addx -1
addx -8
addx 13
addx 4
noop
addx -1
addx 5
addx -1
addx 5
addx -1
addx 5
addx -1
addx 5
addx -1
addx -35
addx 1
addx 24
addx -19
addx 1
addx 16
addx -11
noop
noop
addx 21
addx -15
noop
noop
addx -3
addx 9
addx 1
addx -3
addx 8
addx 1
addx 5
noop
noop
noop
noop
noop
addx -36
noop
addx 1
addx 7
noop
noop
noop
addx 2
addx 6
noop
noop
noop
noop
noop
addx 1
noop
noop
addx 7
addx 1
noop
addx -13
addx 13
addx 7
noop
addx 1
addx -33
noop
noop
noop
addx 2
noop
noop
noop
addx 8
noop
addx -1
addx 2
addx 1
noop
addx 17
addx -9
addx 1
addx 1
addx -3
addx 11
noop
noop
addx 1
noop
addx 1
noop
noop
addx -13
addx -19
addx 1
addx 3
addx 26
addx -30
addx 12
addx -1
addx 3
addx 1
noop
noop
noop
addx -9
addx 18
addx 1
addx 2
noop
noop
addx 9
noop
noop
noop
addx -1
addx 2
addx -37
addx 1
addx 3
noop
addx 15
addx -21
addx 22
addx -6
addx 1
noop
addx 2
addx 1
noop
addx -10
noop
noop
addx 20
addx 1
addx 2
addx 2
addx -6
addx -11
noop
noop
noop

145
input/day-10.txt
View file

@ -1,145 +0,0 @@
noop
noop
noop
addx 6
noop
addx 30
addx -26
noop
addx 5
noop
noop
noop
noop
addx 5
addx -5
addx 6
addx 5
addx -1
addx 5
noop
noop
addx -14
addx -18
addx 39
addx -39
addx 25
addx -22
addx 2
addx 5
addx 2
addx 3
addx -2
addx 2
noop
addx 3
addx 2
addx 2
noop
addx 3
noop
addx 3
addx 2
addx 5
addx 4
addx -18
addx 17
addx -38
addx 5
addx 2
addx -5
addx 27
addx -19
noop
addx 3
addx 4
noop
noop
addx 5
addx -1
noop
noop
addx 4
addx 5
addx 2
addx -4
addx 5
noop
addx -11
addx 16
addx -36
noop
addx 5
noop
addx 28
addx -23
noop
noop
noop
addx 21
addx -18
noop
addx 3
addx 2
addx 2
addx 5
addx 1
noop
noop
addx 4
noop
noop
noop
noop
noop
addx 8
addx -40
noop
addx 7
noop
addx -2
addx 5
addx 2
addx 25
addx -31
addx 9
addx 5
addx 2
addx 2
addx 3
addx -2
noop
addx 3
addx 2
noop
addx 7
addx -2
addx 5
addx -40
addx 20
addx -12
noop
noop
noop
addx -5
addx 7
addx 7
noop
addx -1
addx 1
addx 5
addx 3
addx -2
addx 2
noop
addx 3
addx 2
noop
noop
noop
noop
addx 7
noop
noop
noop
noop

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

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