143 lines
3.6 KiB
Common Lisp
143 lines
3.6 KiB
Common Lisp
(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))
|
|
(deftype direction () '(member :north :east :south :west))
|
|
(defstruct guard
|
|
(x 0 :type fixnum)
|
|
(y 0 :type fixnum)
|
|
(dir :north :type direction))
|
|
|
|
|
|
(defun blockedp (labo g &optional extra-block)
|
|
(or (eq #\# (aref labo (guard-y g) (guard-x g)))
|
|
(and
|
|
extra-block
|
|
(eq (guard-x g) (car extra-block))
|
|
(eq (guard-y g) (cdr extra-block)))))
|
|
|
|
(defun find-guard (labo)
|
|
(declare (type (array t (* *)) labo))
|
|
(first (loop for x from 0 to (1- (array-dimension labo 0))
|
|
append (loop for y from 0 to (1- (array-dimension labo 1))
|
|
if (eq #\^ (aref labo y x))
|
|
collect (make-guard :x x :y y :dir :north)))))
|
|
|
|
(defun move (g)
|
|
(declare (type guard g))
|
|
(let ((dir (guard-dir g)))
|
|
(case dir
|
|
(:north (make-guard :x (guard-x g) :y (1- (guard-y g)) :dir dir))
|
|
(:east (make-guard :x (1+ (guard-x g)) :y (guard-y g) :dir dir))
|
|
(:south (make-guard :x (guard-x g) :y (1+ (guard-y g)) :dir dir))
|
|
(:west (make-guard :x (1- (guard-x g)) :y (guard-y g) :dir dir)))))
|
|
|
|
(defun out-labop (labo g)
|
|
(declare (type (array t (* *)) labo)
|
|
(type (or null guard) g))
|
|
(not
|
|
(and
|
|
g
|
|
(< -1 (guard-x g) (array-dimension labo 1))
|
|
(< -1 (guard-y g) (array-dimension labo 0)))))
|
|
|
|
|
|
(defun guard-rotate (g)
|
|
(declare (type guard g))
|
|
(make-guard :x (guard-x g) :y (guard-y g)
|
|
:dir (case (guard-dir g)
|
|
(:north :east)
|
|
(:east :south)
|
|
(:south :west)
|
|
(:west :north))))
|
|
|
|
(defun guard-move (labo guard &optional (extra-block nil))
|
|
(let ((new-guard (move guard)))
|
|
(cond
|
|
((out-labop labo new-guard) nil)
|
|
((blockedp labo new-guard extra-block)
|
|
(guard-move labo (guard-rotate guard) extra-block))
|
|
(t new-guard))))
|
|
|
|
(defun guard-hash (g)
|
|
(declare (type (or null guard) g))
|
|
(if g
|
|
(+ (* 10000 (guard-y g))
|
|
(* 10 (guard-x g))
|
|
(case (guard-dir g)
|
|
(:north 0)
|
|
(:east 1)
|
|
(:south 2)
|
|
(:west 3)))
|
|
0))
|
|
|
|
(defun hash-to-pos (h)
|
|
(cons
|
|
(floor (/ h 10000))
|
|
(mod (floor (/ h 10)) 1000)
|
|
))
|
|
|
|
(defun guard-path (labo guard &optional (path (make-hash-table :size 10000)) (extra-block nil))
|
|
(let ((hash (guard-hash guard)))
|
|
(cond
|
|
((not guard) (remove-duplicates (loop for k being the hash-keys of path collect (floor (/ k 10)))))
|
|
((gethash hash path) nil)
|
|
(t (progn
|
|
(setf (gethash hash path) 1)
|
|
(guard-path labo (guard-move labo guard extra-block) path extra-block))))))
|
|
|
|
(defun part1 (data)
|
|
(format nil "~A" (length (guard-path data (find-guard data)))))
|
|
|
|
(defun looping-blocks (labo)
|
|
(let* ((g (find-guard labo))
|
|
(route (guard-path labo g)))
|
|
(loop for s in route
|
|
for b = (cons (mod s 1000) (floor (/ s 1000)))
|
|
unless (guard-path labo g (make-hash-table :size 10000) b)
|
|
collect b)))
|
|
|
|
(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)))
|
|
|