From 499f5947659e11a24ce899501d834fc86962df2b Mon Sep 17 00:00:00 2001
From: Oscar Najera <hi@oscarnajera.com>
Date: Sun, 17 Dec 2023 10:26:20 +0100
Subject: [AoC2023] day16 lisp

---
 AoC2023/day16/solver.lisp | 93 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 93 insertions(+)
 create mode 100644 AoC2023/day16/solver.lisp

(limited to 'AoC2023/day16/solver.lisp')

diff --git a/AoC2023/day16/solver.lisp b/AoC2023/day16/solver.lisp
new file mode 100644
index 0000000..8b967a4
--- /dev/null
+++ b/AoC2023/day16/solver.lisp
@@ -0,0 +1,93 @@
+;;8:57
+;;10:26 part1
+(ql:quickload '(fiveam arrows alexandria))
+(defparameter eg-in "")
+
+(defun in-bounds (field ray)
+  (destructuring-bind (maxrow maxcol) (array-dimensions field)
+    (destructuring-bind (dir row col) ray
+      (declare (ignorable dir))
+      (and (< -1 row maxrow)
+           (< -1 col maxcol)))))
+
+(defun next-direction (ray)
+  (destructuring-bind (dir row col) ray
+    (cons dir
+          (ecase dir
+            (up (list (1- row) col))
+            (lf (list row (1- col)))
+            (dw (list (1+ row) col))
+            (rt (list row (1+ col)))))))
+
+(defun mirror-bs (ray)
+  (destructuring-bind (dir row col) ray
+    (arrows:->
+        (ecase dir
+          (up 'lf)
+          (lf 'up)
+          (dw 'rt)
+          (rt 'dw))
+        (list row col)
+        (list))))
+
+(defun mirror-fs (ray)
+  (destructuring-bind (dir row col) ray
+    (arrows:->
+        (ecase dir
+          (up 'rt)
+          (lf 'dw)
+          (dw 'lf)
+          (rt 'up))
+        (list row col)
+        (list))))
+
+(defun split-v (ray)
+  (destructuring-bind (dir row col) ray
+    (ecase dir
+      ((up dw) (list ray))
+      ((lf rt) (list (list 'up row col) (list 'dw row col)) ))))
+
+(defun split-h (ray)
+  (destructuring-bind (dir row col) ray
+    (ecase dir
+      ((lf rt) (list ray))
+      ((up dw) (list (list 'lf row col) (list 'rt row col)) ))))
+
+(defun energized-p (energized ray)
+  (destructuring-bind (dir row col) ray
+    (find dir (gethash (cons row col) energized))))
+
+(defun action (field ray energized)
+  (destructuring-bind (dir row col) ray
+    (unless (find dir (gethash (cons row col) energized)))
+    (arrows:->>
+     (ecase (aref field row col)
+       (#\. (list ray))
+       (#\\ (mirror-bs ray))
+       (#\/ (mirror-fs ray))
+       (#\| (split-v ray))
+       (#\- (split-h ray)))
+     (mapcar #'next-direction)
+     (remove-if-not (alexandria:curry #'in-bounds field))
+     (remove-if (alexandria:curry #'energized-p energized)))))
+
+(defun advancer (field rays energized maxi)
+  (loop for (dir row col) in rays do
+    (push dir (gethash (cons row col) energized)))
+  (if (or (null rays) (> maxi 5000))
+      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 (1+ maxi)))))
+
+(defun solver1 (input)
+  (let* ((rows (length input))
+         (energized (make-hash-table :test #'equal))
+         (field
+           (make-array (list rows (length (car input))) :initial-contents input)))
+    (advancer field (list (list 'rt 0 0)) energized 0)
+    (hash-table-count energized)))
+
+(fiveam:test solutions
+  (fiveam:is (= 46 (solver1 (uiop:read-file-lines "eg-in"))))
+  (fiveam:is (= 7996 (solver1 (uiop:read-file-lines "input")))))
-- 
cgit v1.2.3