Day 6: Guard Gallivant
Megathread guidelines
- Keep top level comments as only solutions, if you want to say something other than a solution put it in a new post. (replies to comments can be whatever)
- You can send code in code blocks by using three backticks, the code, and then three backticks or use something such as https://topaz.github.io/paste/ if you prefer sending it through a URL
FAQ
- What is this?: Here is a post with a large amount of details: https://programming.dev/post/6637268
- Where do I participate?: https://adventofcode.com/
- Is there a leaderboard for the community?: We have a programming.dev leaderboard with the info on how to join in this post: https://programming.dev/post/6631465
You are viewing a single thread.
View all comments 4 points
Lisp
Brute forced part 2, but got a lot of reuse from part 1.
Part 1 and 2
(defvar *part1* "inputs/day06-part1")
(defvar *part1-test* "inputs/day06-part1-test")
(defstruct move x y direction)
(defstruct guard direction x y (moves (make-hash-table :test 'equalp)))
(defun convert-direction (g)
(case g
(^ 'up)
(> 'right)
(< 'left)
(v 'down)))
(defun find-guard (map)
(destructuring-bind (rows cols) (array-dimensions map)
(loop for j from 0 below rows
do (loop for i from 0 below cols
for v = (aref map j i)
when (not (or (eql '|.| v) (eql '|#| v)))
do (return-from find-guard (make-guard :direction (convert-direction v) :x i :y j ))))))
(defun turn-guard (guard)
(case (guard-direction guard)
(UP (setf (guard-direction guard) 'RIGHT))
(DOWN (setf (guard-direction guard) 'LEFT))
(LEFT (setf (guard-direction guard) 'UP))
(RIGHT (setf (guard-direction guard) 'DOWN))))
(defun on-map (map x y)
(destructuring-bind (rows cols) (array-dimensions map)
(and (>= x 0) (>= y 0)
(< y rows) (< x cols))))
(defun mark-guard (map guard)
(setf (aref map (guard-y guard) (guard-x guard)) 'X))
(defun next-pos (guard)
(case (guard-direction guard)
(UP (list (guard-x guard) (1- (guard-y guard))))
(DOWN (list (guard-x guard) (1+ (guard-y guard))))
(LEFT (list (1- (guard-x guard)) (guard-y guard)))
(RIGHT (list (1+ (guard-x guard)) (guard-y guard)))))
(defun move-guard (map guard)
(destructuring-bind (x y) (next-pos guard)
(if (on-map map x y)
(if (eql '|#| (aref map y x))
(turn-guard guard)
(progn (setf (guard-x guard) x)
(setf (guard-y guard) y)))
(setf (guard-direction guard) nil))))
(defun run-p1 (file)
(let* ((map (list-to-2d-array (read-file file #'to-symbols)))
(guard (find-guard map)))
(mark-guard map guard)
(loop while (guard-direction guard)
do (mark-guard map guard)
do (move-guard map guard))
(destructuring-bind (rows cols) (array-dimensions map)
(loop for y from 0 below rows sum (loop for x from 0 below cols count (eql (aref map y x) 'X))))))
(defun save-move (guard move)
(setf (gethash move (guard-moves guard)) t))
(defun reset-moves (guard)
(setf (guard-moves guard) nil))
(defun is-loop (x y map original-guard)
;; can only set new blocks in blank spaces
(unless (eql '|.| (aref map y x)) (return-from is-loop nil))
(let ((guard (copy-guard original-guard)))
;; save the initial guard position
(save-move guard (make-move :x (guard-x guard) :y (guard-y guard) :direction (guard-direction guard)))
;; set the "new" block
(setf (aref map y x) '|#|)
;; loop and check for guard loops
(let ((result
(loop
while (move-guard map guard)
for move = (make-move :x (guard-x guard) :y (guard-y guard) :direction (guard-direction guard))
;; if we have seen the move before, then it is a loop
if (gethash move (guard-moves guard))
return t
else
do (save-move guard move)
finally
(return nil))))
;; reset initial position
(setf (aref map y x) '|.|)
(clrhash (guard-moves guard))
result)))
(defun run-p2 (file)
(let* ((map (list-to-2d-array (read-file file #'to-symbols)))
(guard (find-guard map)))
(destructuring-bind (rows cols) (array-dimensions map)
(loop for y from 0 below rows
sum (loop for x from 0 below cols
count (is-loop x y map guard)))
)))
