1(defpackage #:advent.2024.06
2 (:use #:cl #:advent.2024.00))
3(in-package #:advent.2024.06)
4
5;;; Part 1.
6
7(defparameter *blocks* ())
8(defparameter *guard* nil)
9(defparameter *direction* nil)
10(defparameter *covered* nil)
11(defparameter *width* nil)
12(defparameter *height* nil)
13
14(defun reset ()
15 (setf *blocks* nil
16 *guard* nil
17 *direction* nil
18 *width* nil
19 *height* nil
20 *covered* nil))
21
22(defun init (&optional (file (input)))
23 "Convert the contents of FILE into a 2d array of characters."
24 (reset)
25 (let* ((lines (uiop:read-file-lines file)))
26 (loop for line in lines
27 for i from 0
28 do (loop for char across line
29 for j from 0 do
30 (case char ; (aref res i j)
31 (#\#
32 (push (cons i j) *blocks*))
33 (#\^
34 (setf *guard* (cons i j)
35 *direction* 'up))
36 ((#\V #\v)
37 (setf *guard* (cons i j)
38 *direction* 'down))
39 (#\{{CONTENT}}gt;
40 (setf *guard* (cons i j)
41 *direction* 'right))
42 (#\{{CONTENT}}lt;
43 (setf *guard* (cons i j)
44 *direction* 'left)))
45 finally (setf *height* i
46 *width* j
47 *covered*
48 (make-array (list i j) :initial-element 0))))
49 t))
50
51(defun move (direction)
52 "Try to move in DIRECTION.
53If there's a block there, return NIL.
54Otherwise, update the guard's position and return the new position."
55 (let* ((line (car *guard*))
56 (col (cdr *guard*))
57 (next-point
58 (case direction
59 (up (cons (1- line) col))
60 (down (cons (1+ line) col))
61 (left (cons line (1- col)))
62 (right (cons line (1+ col))))))
63 (when (> (aref *covered* line col) 25)
64 (error 'loop!))
65 (unless (find next-point *blocks* :test #'equal)
66 (setf *guard* next-point)
67 (incf (aref *covered* line col)))))
68
69(defun step-guard ()
70 (unless (move *direction*)
71 (progn
72 (setf *direction*
73 (case *direction*
74 (up 'right)
75 (down 'left)
76 (left 'up)
77 (right 'down)))
78 (step-guard))))
79
80(define-condition loop! (error)
81 ()
82 (:report (lambda (condition stream)
83 (declare (ignorable condition))
84 (format stream "Loop detected!"))))
85
86(defun count-covered ()
87 (destructuring-bind (n m) (array-dimensions *covered*)
88 (let ((count 1))
89 (loop for i from 0 below n do
90 (loop for j from 0 below m do
91 (unless (zerop (aref *covered* i j))
92 (incf count))))
93 count)))
94
95(defun solve1 (&optional (input (input)))
96 (init input)
97 (loop until (or (= (car *guard*) *height*)
98 (= (cdr *guard*) *width*)
99 (= (car *guard*) 0)
100 (= (cdr *guard*) 0))
101 do (step-guard))
102 (count-covered))
103
104;;; Part 2.
105;; Find all the places where you could put *one* new obstacle to get the guard
106;; stuck in a loop.
107;;
108;; OK, so to get stuck in a loop the guard needs 4 obstacles that would make the
109;; guard trace a rectangle, *without* any other obstacles in their paths ---
110;; (x, y)
111;; ->(x, {y-1 ,, 1})
112;; ->({x+1 .. (width-1)}, ny)
113;; ->(nx, {ny+1 .. (height-1)})
114;;
115;; so (1) check each stone to find if it is the corner of a square. record each square.
116;; (2) take the corners and make sure there are no stones in the path of the
117;; guard for each square
118
119;;; ... or, you know, do the brutiest of forces.
120
121(defun solve2 (&optional (input (input)))
122 (init input)
123 (let ((res 0))
124 (loop for row from 0 upto *height* do
125 (loop for col from 0 upto *width* do
126 (unless (find (cons row col) *blocks* :test #'equal)
127 (init input)
128 (let ((*blocks* (cons (cons row col) *blocks*)))
129 ;; (print (cons row col))
130 (handler-case
131 (loop until (or (= (car *guard*) *height*)
132 (= (cdr *guard*) *width*)
133 (= (car *guard*) 0)
134 (= (cdr *guard*) 0))
135 do (step-guard))
136 (loop! ()
137 (princ "*")
138 (incf res)))))))
139 (print res)
140 res))
141
142;; 377 too low
143;; 1502 too low
144;;; OFF BY ONE ERRRORRRRRRRRRRR
145;; 1503 was the answer for me