1 files changed, 87 insertions, 0 deletions
diff --git a/AoC2023/day10/solver.lisp b/AoC2023/day10/solver.lisp
new file mode 100644
index 0000000..fcc1eed
--- /dev/null
+++ b/AoC2023/day10/solver.lisp
@@ -0,0 +1,87 @@
+;;05:32
+
+(ql:quickload '(fiveam))
+
+(defparameter directions
+  '((up 0 -1)
+    (dw 0  1)
+    (lf -1 0)
+    (rt  1 0)))
+
+(defparameter pipes
+  '((#\| up dw)
+    (#\- lf rt)
+    (#\L up rt)
+    (#\J up lf)
+    (#\7 dw lf)
+    (#\F dw rt)
+    (#\.)
+    (#\S up dw lf rt)))
+
+(defparameter eg-input
+  "7-F7-
+.FJ|7
+SJLL7
+|F--J
+LJ.LJ")
+
+(defun get-neighbors (point)
+  (mapcar
+   (lambda (dir)
+     (cdr (assoc dir directions)))
+   (cdr (assoc point pipes))))
+
+(fiveam:test parts
+  (fiveam:is (equal '((-1 0) (1 0))
+                    (get-neighbors #\-))))
+
+
+(defun find-start (map)
+  (loop for row across map
+        for y from 0 do
+          (loop for col across row
+                for x from 0
+                when (eq #\S col)
+                  do (return-from find-start (list y x)))))
+
+(defun move-next (map point)
+  (flet ((bounds (y x)
+           (let ((ymax (length map))
+                 (xmax (length (aref map 0))))
+             (when (and (< -1 y ymax)
+                        (< -1 x xmax))
+               (list y x)))))
+    (destructuring-bind (y x) point
+      (loop for (dx dy) in (get-neighbors (aref (aref map y) x))
+            when (bounds (+ y dy) (+ x dx)) collect it))))
+
+(defun start-neighbors (map start)
+  (remove-if-not
+   (lambda (n)
+     (member start (move-next map n) :test #'equal))
+   (move-next map start)))
+
+(defun advance-next (map point last)
+  (let ((next (move-next map point)))
+    (if (equal last (car next))
+        (cadr next)
+        (car next))))
+
+(defun solver1 (rows)
+  (let* ((map (make-array (length rows) :initial-contents rows))
+         (start (find-start map))
+         (options (start-neighbors map start))
+         (last start)
+         (cur (car options))
+         )
+    (loop
+      for next = (advance-next map cur last)
+      for steps from 1
+      until (equal next start)
+      do (setf last cur
+               cur next)
+      finally (return (floor (+ steps 1) 2)))))
+
+(fiveam:test solution
+  (fiveam:is (= 8 (solver1 (uiop:split-string eg-input :separator '(#\Newline)))))
+  (fiveam:is (= 6812 (solver1 (uiop:read-file-lines "input")))))