aboutsummaryrefslogtreecommitdiffstats
path: root/AoC2023/day16/solver-structs.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'AoC2023/day16/solver-structs.lisp')
-rw-r--r--AoC2023/day16/solver-structs.lisp111
1 files changed, 111 insertions, 0 deletions
diff --git a/AoC2023/day16/solver-structs.lisp b/AoC2023/day16/solver-structs.lisp
new file mode 100644
index 0000000..c28c1ca
--- /dev/null
+++ b/AoC2023/day16/solver-structs.lisp
@@ -0,0 +1,111 @@
+;;8:57
+;;10:26 part1
+;;10:53 part2
+(ql:quickload '(fiveam arrows alexandria))
+
+(defstruct ray
+ dir row col)
+
+(defun in-bounds (field ray)
+ (destructuring-bind (maxrow maxcol) (array-dimensions field)
+ (with-slots (row col) ray
+ (and (< -1 row maxrow)
+ (< -1 col maxcol)))))
+
+(defun next-direction (ray)
+ (with-slots (dir row col) ray
+ (ecase dir
+ (up (decf row))
+ (lf (decf col))
+ (dw (incf row))
+ (rt (incf col))))
+ ray)
+
+(defun mirror-bs (ray)
+ (with-slots (dir row col) ray
+ (arrows:->>
+ (ecase dir
+ (up 'lf)
+ (lf 'up)
+ (dw 'rt)
+ (rt 'dw))
+ (setf dir)))
+ ray)
+
+(defun mirror-fs (ray)
+ (with-slots (dir row col) ray
+ (arrows:->>
+ (ecase dir
+ (up 'rt)
+ (rt 'up)
+ (lf 'dw)
+ (dw 'lf))
+ (setf dir)))
+ ray)
+
+(defun split (ray alignment)
+ (with-slots (dir row col) ray
+ (mapcar (lambda (d) (make-ray :dir d :row row :col col))
+ (cond
+ ((and (eq alignment 'vertical) (member dir '(lf rt))) '(up dw))
+ ((and (eq alignment 'horizontal) (member dir '(up dw))) '(lf rt))
+ ((list dir))))))
+
+(defun energized-p (energized ray)
+ (with-slots (dir row col) ray
+ (find dir (gethash (cons row col) energized))))
+
+(defun ensure-list (l) (if (listp l) l (list l)))
+
+(defun action (field ray energized)
+ (with-slots (dir row col) ray
+ (arrows:->>
+ (ecase (aref field row col)
+ (#\. ray)
+ (#\\ (mirror-bs ray))
+ (#\/ (mirror-fs ray))
+ (#\| (split ray 'vertical))
+ (#\- (split ray 'horizontal)))
+ (ensure-list)
+ (mapcar #'next-direction)
+ (remove-if-not (alexandria:curry #'in-bounds field))
+ (remove-if (alexandria:curry #'energized-p energized)))))
+
+(defun advancer (field rays energized)
+ (dolist (r rays)
+ (with-slots (dir row col) r
+ (push dir (gethash (cons row col) energized))))
+ (if (null rays)
+ energized
+ (let ((next-moves (mapcan (lambda (ray) (action field ray energized)) rays)))
+ ;; (format t "~d Next: ~a~%" maxi next-moves)
+ (advancer field next-moves energized))))
+
+(defun boundary-rays (field)
+ (destructuring-bind (maxrow maxcol) (array-dimensions field)
+ (mapcar (lambda (point)
+ (destructuring-bind (dir row col) point
+ (make-ray :dir dir :row row :col col)))
+ (append
+ (loop for i below maxrow collect (list 'rt i 0))
+ (loop for i below maxrow collect (list 'lf i (1- maxcol)))
+ (loop for i below maxcol collect (list 'dw 0 i))
+ (loop for i below maxcol collect (list 'up (1- maxrow) i))))))
+
+(defun solver (field)
+ (lambda (start)
+ (hash-table-count
+ (advancer field (list start)
+ (make-hash-table :test #'equal)))))
+
+(defun solution (input &optional (starter (constantly (list (make-ray :dir 'rt :row 0 :col 0)))))
+ (let* ((rows (length input))
+ (field
+ (make-array (list rows (length (car input))) :initial-contents input)))
+ (reduce #'max (funcall starter field) :key (solver field))))
+
+(fiveam:test solutions
+ (fiveam:is (= 46 (solution (uiop:read-file-lines "eg-in"))))
+ (fiveam:is (= 7996 (solution (uiop:read-file-lines "input"))))
+ (fiveam:is (= 51 (solution (uiop:read-file-lines "eg-in") #'boundary-rays)))
+ (fiveam:is (= 8239 (solution (uiop:read-file-lines "input") #'boundary-rays))))