moving on cube surface

1 files changed, 114 insertions, 126 deletions

diff --git a/AoC2022/22/solver.lisp b/AoC2022/22/solver.lisp
index efab725..062e441 100644
--- a/AoC2022/22/solver.lisp
+++ b/AoC2022/22/solver.lisp
@@ -52,16 +52,14 @@
               new-state
               (advance field new-state)))))))
 
-(defconstant +directions+ #(north east south west))
-
-(defun new-direction (current-direction turn)
-  (svref +directions+
+(defun new-direction (current-direction turn &optional (directions #(north east south west)))
+  (svref directions
          (mod
           (+
            (ecase turn
              (left -1)
              (right 1))
-           (position current-direction +directions+))
+           (position current-direction directions))
           4)))
 
 (defun walk (field state steps)
@@ -73,13 +71,6 @@
               (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
@@ -100,56 +91,7 @@
             (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"))))
-
-(defun face-coords (state face-length)
-  (with-slots (x-pos y-pos) state
-    (multiple-value-bind (x-face x-coord)
-        (floor x-pos face-length)
-      (multiple-value-bind (y-face y-coord)
-          (floor y-pos face-length)
-        (list x-face y-face x-coord y-coord)))))
-
-(defun cube-advance (field state face-length)
-  (destructuring-bind (x-face y-face x-coord y-coord) (face-coords state (floor (array-dimension field 0) 3))
-    (let ((new-x (+ x-coord (case direction (< -1) (> 1) (t 0))))
-          (new-y (+ y-coord (case direction (^ -1) (v 1) (t 0))))))
-    (if (and
-         (<= 0 new-x face-length)
-         (<= 0 new-y face-length))
-        (make-state :x-pos (+ new-x (* x-face face-length))
-                    :y-pos (+ new-y (* y-face face-length)) :direction direction))
-
-
-    (with-slots (direction x-pos y-pos) state
-      (floor (+ x-pos
-                (case direction (< -1) (> 1) (t 0)))
-             face-length)
-      (floor (+ y-pos
-                (case direction (^ -1) (v 1) (t 0)))
-             face-lendth)
-      (destructuring-bind (new-x new-y)
-          (case direction
-            (^ -1) (list x-pos (floor (1- y-pos) face-length))
-            (v 1) (list x-pos (floor (1+ y-pos) face-length))
-            (> 1)  (list (floor (1+ x-pos) face-length) y-pos)
-            (< -1)  (list (floor (1- x-pos) face-length) 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
-              (cube-advance field new-state)))))))
-
-(values (values 5 6) (values 9 2))
-
-(floor (array-dimension (create-field "eg-in") 0) 3)
-
-(let ((a 5))
-  (trivia:match (list 5 6 2)
-    ((trivia:guard (list 5 op 2)
-                   (= op (1+ a))) 'hu)))
-
+;;; part 2
 ;;; Cube face layout
 ;;;   1
 ;;; 234
@@ -162,67 +104,113 @@
 ;;; 5=2 2
 ;;; 6=3 2
 
-(trivia:match (list x-face y-face direction)
-  ;; Face 1
-  ((list 2 0 '>) (list 3 2 '<)) ;; 1-6
-  ((list 2 0 'v) (list 2 1 'v)) ;; 1-4
-  ((list 2 0 '<) (list 1 1 'v)) ;; 1-3
-  ((list 2 0 '^) (list 0 1 'v)) ;; 1-2
-  ;; Face 2
-  ((list 0 1 '>) (list 1 1 '>)) ;; 2-3
-  ((list 0 1 'v) (list 2 2 '^)) ;; 2-5
-  ((list 0 1 '<) (list 3 2 '^)) ;; 2-6
-  ((list 0 1 '^) (list 2 0 'v)) ;; 2-1
-  ;; Face 3
-  ((list 1 1 '>) (list 2 1 '>)) ;; 3-4
-  ((list 1 1 'v) (list 2 2 '>)) ;; 3-5
-  ((list 1 1 '<) (list 0 1 '<)) ;; 3-2
-  ((list 1 1 '^) (list 2 0 '>)) ;; 3-1
-  ;; Face 4
-  ((list 2 1 '>) (list 3 2 'v)) ;; 4-6
-  ((list 2 1 'v) (list 2 2 'v)) ;; 4-5
-  ((list 2 1 '<) (list 1 1 '<)) ;; 4-3
-  ((list 2 1 '^) (list 2 0 '^)) ;; 4-1
-  ;; Face 5
-  ((list 2 2 '>) (list 3 2 '>)) ;; 5-6
-  ((list 2 2 'v) (list 0 1 '^)) ;; 5-2
-  ((list 2 2 '<) (list 1 1 '^)) ;; 5-3
-  ((list 2 2 '^) (list 2 1 '^)) ;; 5-4
-  ;; Face 6
-  ((list 3 2 '>) (list 2 0 '<)) ;; 6-1
-  ((list 3 2 'v) (list 0 1 '>)) ;; 6-2
-  ((list 3 2 '<) (list 2 2 '<)) ;; 6-5
-  ((list 3 2 '^) (list 2 1 '<)) ;; 6-4
-  )
-
-(trivia:match '(> 5)
-  ((list '> op) 6))
-
-(let ((fl 4))
-  (destructuring-bind (x-face y-face x-coord y-coord) (list 2 0 -1 1)
-    (trivia:match (list x-face y-face x-coord y-coord)
-      ;; Face 1 to its 4 neighbors 6,4,3,2
-      ((trivia:guard
-        (list 2 0 x y) ;; Neighbor 6
-        (= (* 3 fl) x))
-       (make-state :x-pos (1- (* 4 fl)) :y-pos (- (* 3 fl) y 1) :direction '<))
-      ((trivia:guard ;; neighbor 4 is contiguous; no change
-        (list 2 0 x y)
-        (= fl y))
-       (make-state :x-pos (+ x  (* 2 fl)) :y-pos fl :direction 'v))
-      ((list 2 0 -1 y) ;; Neighbor 3
-       (make-state :x-pos (+ y fl) :y-pos fl :direction 'v))
-      ((list 2 0 x -1) ;; neighbor 2
-       (make-state :x-pos (- fl x) :y-pos fl :direction 'v))
-      ;; Face 2 to its 4 neighbors 3,5,6,1
-      ((trivia:guard ;; Neighbor 3 contiguous
-        (list 0 1 x y)
-        (= x fl))
-       (make-state :x-pos fl :y-pos (+ y fl) :direction '>))
-      ((trivia:guard ;; Neighbor 5
-        (list 0 1 x y)
-        (= y (* 2 fl)))
-       (make-state :x-pos (- fl x 1) :y-pos (1- (* 3 fl)) :direction '^))
-
-
-    )))
+(defparameter +face-label+
+  '((1 . (2 0))
+    (2 . (0 1))
+    (3 . (1 1))
+    (4 . (2 1))
+    (5 . (2 2))
+    (6 . (3 2))))
+
+(defun coord->face (x-face y-face)
+  (car (rassoc (list x-face y-face) +face-label+ :test #'equal)))
+
+(defun face->coord (face)
+  (cdr (assoc face  +face-label+ :test #'eq)))
+
+(defun reduced-coords (state face-length)
+  (with-slots (x-pos y-pos) state
+    (multiple-value-bind (x-face x-coord)
+        (floor x-pos face-length)
+      (multiple-value-bind (y-face y-coord)
+          (floor y-pos face-length)
+        (list (coord->face x-face y-face) x-coord y-coord)))))
+
+(defun place-state (face x y direction face-length)
+  (destructuring-bind (x-face y-face) (face->coord face)
+    (make-state :x-pos (+ x (* x-face face-length))
+                :y-pos (+ y (* y-face face-length)) :direction direction)))
+
+(defun face-jump (face direction fl)
+  "fl is face-length"
+  (ecase face
+    (1 (case direction
+         (> (list 6 '< (lambda (_ y) (declare (ignore _)) (list (1- fl)    (- fl y 1)))))
+         (v (list 4 'v (lambda (x _) (declare (ignore _)) (list x          0))))
+         (< (list 3 'v (lambda (_ y) (declare (ignore _)) (list y          0))))
+         (^ (list 2 'v (lambda (x _) (declare (ignore _)) (list (- fl x 1) 0))))))
+    (2 (case direction
+         (> (list 3 '> (lambda (_ y) (declare (ignore _)) (list 0          y))))
+         (v (list 5 '^ (lambda (x _) (declare (ignore _)) (list (- fl x 1) (1- fl)))))
+         (< (list 6 '^ (lambda (_ y) (declare (ignore _)) (list (- fl y 1) (1- fl)))))
+         (^ (list 1 'v (lambda (x _) (declare (ignore _)) (list (- fl x 1) 0))))))
+    (3 (case direction
+         (> (list 4 '> (lambda (_ y) (declare (ignore _)) (list 0       y))))
+         (v (list 5 '> (lambda (x _) (declare (ignore _)) (list 0       (- fl x 1)))))
+         (< (list 2 '< (lambda (_ y) (declare (ignore _)) (list (1- fl) y))))
+         (^ (list 1 '> (lambda (x _) (declare (ignore _)) (list 0       x))))))
+    (4 (case direction
+         (> (list 6 'v (lambda (_ y) (declare (ignore _)) (list (- fl y 1) 0))))
+         (v (list 5 'v (lambda (x _) (declare (ignore _)) (list x          0))))
+         (< (list 3 '< (lambda (_ y) (declare (ignore _)) (list (1- fl)    y))))
+         (^ (list 1 '^ (lambda (x _) (declare (ignore _)) (list x         (1- fl)))))))
+    (5 (case direction
+         (> (list 6 '> (lambda (_ y) (declare (ignore _)) (list 0           y))))
+         (v (list 2 '^ (lambda (x _) (declare (ignore _)) (list (- fl x 1) (1- fl)))))
+         (< (list 3 '^ (lambda (_ y) (declare (ignore _)) (list (- fl y 1) (1- fl)))))
+         (^ (list 4 '^ (lambda (x _) (declare (ignore _)) (list x          (1- fl)))))))
+    (6 (case direction
+         (> (list 1 '< (lambda (_ y) (declare (ignore _)) (list (1- fl) (- fl y 1)))))
+         (v (list 2 '> (lambda (x _) (declare (ignore _)) (list 0       (- fl x 1)))))
+         (< (list 5 '< (lambda (_ y) (declare (ignore _)) (list (1- fl) y))))
+         (^ (list 4 '< (lambda (x _) (declare (ignore _)) (list (1- fl) (- fl x 1)))))))))
+
+(defun cube-advance (state face-length)
+  (destructuring-bind (face x-coord y-coord) (reduced-coords state face-length)
+    (with-slots (direction) state
+      (let ((new-x (+ x-coord (case direction (< -1) (> 1) (t 0))))
+            (new-y (+ y-coord (case direction (^ -1) (v 1) (t 0)))))
+        (if (and
+             (< -1 new-x face-length)
+             (< -1 new-y face-length))
+            (place-state face new-x new-y direction face-length)
+            (destructuring-bind (new-face new-direction pos-fn) (face-jump face direction face-length)
+              (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-advance state face-length))
+          (setf (state-direction state) (new-direction (state-direction state) move #(^ > v <))))
+      ;; (print state)
+      )
+    (equalp orig 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)))
+
+  (fiveam:is (= 1 (coord->face 2 0)))
+  (fiveam:is (= 6 (apply #'coord->face (face->coord 6)))))
+
+;; (let* ((field (create-field "eg-in"))
+;;        (face-length (floor (array-dimension field 0) 3)))
+;;   (fiveam:is
+;;    (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 solutions
+  (fiveam:is (= 6032 (solver "eg-in")))
+  (fiveam:is (= 159034 (solver "input"))))