129 lines
3 KiB
Common Lisp
129 lines
3 KiB
Common Lisp
|
(declaim (optimize (speed 3) (debug 0) (safety 0)))
|
||
|
|
|
||
|
|
(defpackage :aoc/2024/06
|
||
|
|
(:use :cl :aoc :alexandria :trivia)
|
||
|
|
(:export
|
||
|
|
#:sample-data
|
||
|
|
#:sample-data2
|
||
|
|
#:part1
|
||
|
|
#:part2
|
||
|
|
))
|
||
|
|
|
||
|
|
(in-package :aoc/2024/06)
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
(defun parse-input (lines)
|
||
|
|
(let ((l (length lines)))
|
||
|
|
(make-array (list l l)
|
||
|
|
:initial-contents (mapcar (lambda (s) (coerce s 'list)) lines))))
|
||
|
|
|
||
|
|
(defparameter input-text (test-input 2024 6))
|
||
|
|
(defparameter input-data
|
||
|
|
(parse-input (test-input 2024 6)))
|
||
|
|
|
||
|
|
(defparameter sample-text (aoc:split-lines "....#.....
|
||
|
|
.........#
|
||
|
|
..........
|
||
|
|
..#.......
|
||
|
|
.......#..
|
||
|
|
..........
|
||
|
|
.#..^.....
|
||
|
|
........#.
|
||
|
|
#.........
|
||
|
|
......#...
|
||
|
|
"))
|
||
|
|
(defparameter sample-data
|
||
|
|
(parse-input sample-text))
|
||
|
|
|
||
|
|
(defun make-guard (pos direction)
|
||
|
|
(list pos direction))
|
||
|
|
|
||
|
|
(defun guardp (labo pos)
|
||
|
|
(eq #\^ (aref labo (second pos) (first pos))))
|
||
|
|
|
||
|
|
(defun blockedp (labo pos)
|
||
|
|
(eq #\# (aref labo (second pos) (first pos))))
|
||
|
|
|
||
|
|
(defun find-guard (labo)
|
||
|
|
(make-guard
|
||
|
|
(loop for x from 0 to (1- (array-dimension labo 0))
|
||
|
|
for guard-pos = (loop for y from 0 to (1- (array-dimension labo 1))
|
||
|
|
for pos = (list x y)
|
||
|
|
if (guardp labo pos)
|
||
|
|
return pos)
|
||
|
|
if guard-pos
|
||
|
|
return guard-pos)
|
||
|
|
:north))
|
||
|
|
|
||
|
|
(defun move (pos direction)
|
||
|
|
(destructuring-bind (x y) pos
|
||
|
|
(case direction
|
||
|
|
(:north (list x (1- y)))
|
||
|
|
(:east (list (1+ x) y))
|
||
|
|
(:south (list x (1+ y)))
|
||
|
|
(:west (list (1- x) y)))))
|
||
|
|
|
||
|
|
(defun out-labop (labo pos)
|
||
|
|
(destructuring-bind (x y) pos
|
||
|
|
(or
|
||
|
|
(< x 0)
|
||
|
|
(< y 0)
|
||
|
|
(>= x (array-dimension labo 1))
|
||
|
|
(>= y (array-dimension labo 1)))))
|
||
|
|
|
||
|
|
(defun guard-rotate (guard)
|
||
|
|
(let ((direction (second guard)))
|
||
|
|
(make-guard
|
||
|
|
(first guard)
|
||
|
|
(case direction
|
||
|
|
(:north :east)
|
||
|
|
(:east :south)
|
||
|
|
(:south :west)
|
||
|
|
(:west :north)))))
|
||
|
|
|
||
|
|
(defun guard-move (labo guard &optional (extra-block nil))
|
||
|
|
(destructuring-bind (pos dir) guard
|
||
|
|
(let ((new-pos (move pos dir)))
|
||
|
|
(cond
|
||
|
|
((out-labop labo new-pos) nil)
|
||
|
|
((or (blockedp labo new-pos)
|
||
|
|
(equal new-pos extra-block))
|
||
|
|
(guard-move labo (guard-rotate guard) extra-block))
|
||
|
|
(t (make-guard new-pos dir))))))
|
||
|
|
|
||
|
|
(defun guard-path (labo guard &optional (path nil) (extra-block nil))
|
||
|
|
(cond
|
||
|
|
((member guard path :test #'equal) nil)
|
||
|
|
((emptyp guard) (reverse path))
|
||
|
|
(t (guard-path labo (guard-move labo guard extra-block) (push guard path) extra-block))))
|
||
|
|
|
||
|
|
(defun number-squares-covered-by-guard (labo)
|
||
|
|
(let ((squares (mapcar #'first (guard-path labo (find-guard labo)))))
|
||
|
|
(length (remove-duplicates squares :test #'equal))))
|
||
|
|
|
||
|
|
|
||
|
|
(defun part1 (data)
|
||
|
|
(format nil "~A" (number-squares-covered-by-guard data)))
|
||
|
|
|
||
|
|
(defun looping-blocks (labo)
|
||
|
|
(let* ((g (find-guard labo))
|
||
|
|
(route (guard-path labo g)))
|
||
|
|
(remove-duplicates
|
||
|
|
(loop for s in route
|
||
|
|
for b = (first s)
|
||
|
|
unless (guard-path labo g '() b)
|
||
|
|
collect b)
|
||
|
|
:test #'equal)))
|
||
|
|
|
||
|
|
(defun part2 (data)
|
||
|
|
(let* ((lb (looping-blocks data)))
|
||
|
|
(format nil "~A" (length lb))))
|
||
|
|
|
||
|
|
(defun solve-day ()
|
||
|
|
(format t "part1: ~A~%" (part1 input-data))
|
||
|
|
(format t "part2: ~A~%" (part2 input-data)))
|
||
|
|
|