Day 22 part1

1 files changed, 105 insertions, 0 deletions

diff --git a/AoC2022/22/solver.lisp b/AoC2022/22/solver.lisp
new file mode 100644
index 0000000..431158a
--- /dev/null
+++ b/AoC2022/22/solver.lisp
@@ -0,0 +1,105 @@
+(ql:quickload '(fiveam uiop arrows))
+
+(defun parse-instructions (str &optional (start 0))
+  (multiple-value-bind (action str-pos)
+      (case (aref str start)
+        (#\R 'right)
+        (#\L 'left)
+        (t (parse-integer str :start start :junk-allowed t)))
+    (let ((next (or str-pos (1+ start))))
+      (if (= next (length str))
+          (list action)
+          (cons action (parse-instructions str next))))))
+
+(defun create-field (filename)
+  (let* ((data (uiop:read-file-lines filename))
+         (map (butlast data 2))
+         (instructions (car (last data)))
+         (rows (length map))
+         (columns (reduce (lambda (a r) (max a (length r))) map :initial-value 0))
+         (field (make-array (list rows columns) :initial-element nil)))
+    (loop for row in map
+          for i from 0
+          do (loop for entry across row
+                   for j from 0
+                   do (setf (aref field i j)
+                            (ecase entry
+                              (#\. 'free)
+                              (#\# 'wall)
+                              (#\Space nil)))))
+    (values field (parse-instructions instructions))))
+
+
+(defun get-start (field)
+  (loop for i from 0
+        until (aref field 0 i)
+        finally (return i)))
+
+(defstruct state
+  x-pos y-pos direction)
+
+(defun advance (field state)
+  (destructuring-bind (height width) (array-dimensions field)
+    (with-slots (direction x-pos y-pos) state
+      (destructuring-bind (new-x new-y)
+          (ecase direction
+            (north (list x-pos (mod (1- y-pos) height)))
+            (south (list x-pos (mod (1+ y-pos) height)))
+            (east  (list (mod (1+ x-pos) width) y-pos))
+            (west  (list (mod (1- x-pos) width) y-pos)))
+        (let ((new-state (make-state :x-pos new-x :y-pos new-y :direction direction)))
+          (if (aref field new-y new-x)
+              new-state
+              (advance field new-state)))))))
+
+(defconstant +directions+ #(north east south west))
+
+(defun new-direction (current-direction turn)
+  (svref +directions+
+         (mod
+          (+
+           (ecase turn
+             (left -1)
+             (right 1))
+           (position current-direction +directions+))
+          4)))
+
+(defun walk (field state steps)
+  (if (zerop steps)
+      state
+      (let ((new-state (advance field state)))
+        (with-slots (x-pos y-pos) new-state
+            (ecase (aref field y-pos x-pos)
+              (free (walk field new-state (1- steps)))
+              (wall state))))))
+
+(fiveam:test preparation
+  (fiveam:is (eq 'south (new-direction 'east 'right)))
+  (fiveam:is (eq 'west (new-direction 'north 'left)))
+  (fiveam:is (equal
+              (parse-instructions "10R5L5R10L4R5L5" )
+              '(10 RIGHT 5 LEFT 5 RIGHT 10 LEFT 4 RIGHT 5 LEFT 5))))
+
+
+(defun decode-state (state)
+  (with-slots (x-pos y-pos direction) state
+    (+ (* 1000 (1+ y-pos))
+       (* 4 (1+ x-pos))
+       (ecase direction
+         (east 0)
+         (south 1)
+         (west 2)
+         (north 3)))))
+
+(defun solver (filename)
+  (multiple-value-bind (field instructions) (create-field filename)
+    (let ((state (make-state :x-pos (get-start field) :y-pos 0 :direction 'east)))
+      (dolist (move instructions)
+        (if (numberp move)
+            (setf state (walk field state move))
+            (setf (state-direction state) (new-direction (state-direction state) move))))
+      (decode-state state))))
+
+(fiveam:test solutions
+  (fiveam:is (= 6032 (solver "eg-in")))
+  (fiveam:is (= 159034 (solver "input"))))