walk cube

1 files changed, 49 insertions, 25 deletions

diff --git a/AoC2022/22/solver.lisp b/AoC2022/22/solver.lisp
index ca4b83e..b3ea61d 100644
--- a/AoC2022/22/solver.lisp
+++ b/AoC2022/22/solver.lisp
@@ -29,12 +29,6 @@
                               (#\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)
 
@@ -71,6 +65,13 @@
               (free (walk field new-state (1- steps) advance-fn))
               (wall state))))))
 
+(defun traverse (field instructions origin advance-fn)
+  (let ((state (copy-structure origin)))
+    (dolist (move instructions state)
+      (if (numberp move)
+          (setf state (walk field state move advance-fn))
+          (setf (state-direction state) (new-direction (state-direction state) move))))))
+
 (defun decode-state (state)
   (with-slots (x-pos y-pos direction) state
     (+ (* 1000 (1+ y-pos))
@@ -81,14 +82,15 @@
          (< 2)
          (^ 3)))))
 
+(defun get-start (field)
+  (loop for i from 0
+        until (aref field 0 i)
+        finally (return i)))
+
 (defun solver (filename advance-fn)
   (multiple-value-bind (field instructions) (create-field filename)
-    (let ((state (make-state :x-pos (get-start field) :y-pos 0 :direction '>)))
-      (dolist (move instructions)
-        (if (numberp move)
-            (setf state (walk field state move advance-fn))
-            (setf (state-direction state) (new-direction (state-direction state) move))))
-      (decode-state state))))
+    (decode-state
+     (traverse field instructions (make-state :x-pos (get-start field) :y-pos 0 :direction '>) advance-fn))))
 
 ;;; part 2
 ;;; Cube face layout
@@ -111,6 +113,7 @@
     (5 . (2 2))
     (6 . (3 2))))
 
+
 (defun coord->face (x-face y-face)
   (car (rassoc (list x-face y-face) +face-label+ :test #'equal)))
 
@@ -177,16 +180,12 @@
               (destructuring-bind (new-x new-y) (funcall pos-fn x-coord y-coord)
                 (place-state new-face new-x new-y new-direction face-length))))))))
 
-
-
-(defun around-corner-test (start-face face-length)
-  (let* ((orig (place-state start-face 0 0 '^ face-length))
-         (state (copy-structure orig)))
-    (dolist (move '(1 left 1 left 1 left))
-      (if (numberp move)
-          (setf state (cube-step state face-length))
-          (setf (state-direction state) (new-direction (state-direction state) move))))
-    (equalp orig state)))
+(defun copy-clear-field (field)
+  (destructuring-bind (height width) (array-dimensions field)
+    (let ((new-field (make-array (list height width) :initial-element nil)))
+      (loop for y below height
+            do (loop for x below width when (aref field y x) do (setf (aref new-field y x) 'free)))
+      new-field)))
 
 (fiveam:test preparation
   (fiveam:is (eq 'v (new-direction '> 'right)))
@@ -204,9 +203,23 @@
 ;;    (equalp (place-state 2 3 0 'v 4)
 ;;            (cube-advance (place-state 1 0 0 '^ face-length) face-length))))
 
-(fiveam:test around-corner
-  (dotimes (i 6)
-    (fiveam:is (around-corner-test (1+ i) 4))))
+(fiveam:test around-cube
+  (let ((field (copy-clear-field (create-field "eg-in")))
+        (face-length 4))
+    (labels ((advance-fn (state field)
+               (declare (ignore field))
+               (cube-step state face-length))
+             (check (origin moves)
+               (equalp origin
+                       (traverse field moves
+                                 origin #'advance-fn))))
+      ;; around corners
+      (dotimes (i 6)
+        (fiveam:is (check (place-state (1+ i) 0 0 '^ face-length)
+                          '(1 left 1 left 1 left))))
+      ;; walk all dirs straight
+      (dolist (dir '(> v < ^))
+        (fiveam:is (check (place-state 1 2 1 dir face-length) '(16)))))))
 
 (fiveam:test solutions
   (fiveam:is (= 6032 (solver "eg-in" #'wrap-step)))
@@ -217,6 +230,17 @@
 ;; (solver "input" (lambda (state field) (cube-step state 50)))
 
 ;; (multiple-value-bind (field instructions) (create-field "input")
+;;   (destructuring-bind (height width) (array-dimensions field)
+;;     (let ((face-length (gcd height width)))
+;;       (loop for x below (floor width face-length)
+;;             nconc
+;;             (loop for y below (floor height face-length)
+;;                   when (aref field (* y face-length) (* x face-length))
+;;                     collect (list x y)))
+
+;;       )))
+
+;; (multiple-value-bind (field instructions) (create-field "input")
 ;;     (let ((state (place-state 1 0 0 '> 4))
 ;;           (advance-fn (lambda (state) (cube-step state 4))))
 ;;       (dolist (move instructions)