Solved day 22 part 2

This looks horrible and solution path is hard coded

1 files changed, 96 insertions, 35 deletions

diff --git a/AoC2022/22/solver.lisp b/AoC2022/22/solver.lisp
index 362c017..8f7b598 100644
--- a/AoC2022/22/solver.lisp
+++ b/AoC2022/22/solver.lisp
@@ -114,22 +114,22 @@
     (6 . (3 2))))
 
 
-(defun coord->face (x-face y-face)
-  (car (rassoc (list x-face y-face) +face-label+ :test #'equal)))
+(defun coord->face (x-face y-face faces)
+  (car (rassoc (list x-face y-face) faces :test #'equal)))
 
-(defun face->coord (face)
-  (cdr (assoc face  +face-label+ :test #'eq)))
+(defun face->coord (face faces)
+  (cdr (assoc face faces :test #'eq)))
 
-(defun reduced-coords (state face-length)
+(defun reduced-coords (state face-length faces)
   (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)))))
+        (list (coord->face x-face y-face faces) x-coord y-coord)))))
 
-(defun place-state (face x y direction face-length)
-  (destructuring-bind (x-face y-face) (face->coord face)
+(defun place-state (face x y direction face-length faces)
+  (destructuring-bind (x-face y-face) (face->coord face faces)
     (make-state :x-pos (+ x (* x-face face-length))
                 :y-pos (+ y (* y-face face-length)) :direction direction)))
 
@@ -184,19 +184,65 @@
            (< (list 5 '< #'cross-x))
            (v (list 2 '> (compose #'rot-ccw #'cross-y)))
            (^ (list 4 '< (compose #'rot-ccw #'cross-y))))))))
+;;  36
+;;  4
+;; 15
+;; 2
+(defun problem-face-jump (face direction fl)
+  "fl is face-length"
+  (flet ((rot-ccw (x y) (list y  (- fl 1 x)))
+         (rot-cw  (x y) (list (- fl 1 y) x))
+         (cross-x (x y) (list (- fl 1 x) y))
+         (cross-y (x y) (list x  (- fl 1 y)))
+         (compose (&rest funcs)
+           (reduce (lambda (f g)
+                     (lambda (&rest args)
+                       (apply f (apply g args))))
+                   funcs)))
+    (ecase face
+      (1 (case direction
+           (> (list 5 '> #'cross-x))
+           (< (list 3 '> (compose #'rot-cw #'rot-cw #'cross-x)))
+           (v (list 2 'v #'cross-y))
+           (^ (list 4 '> (compose #'rot-cw #'cross-y)))))
+      (2 (case direction
+           (> (list 5 '^ (compose #'rot-ccw #'cross-x)))
+           (< (list 3 'v (compose #'rot-cw #'rot-cw #'rot-cw #'cross-x)))
+           (v (list 6 'v #'cross-y))
+           (^ (list 1 '^ #'cross-y))))
+      (3 (case direction
+           (> (list 6 '> #'cross-x))
+           (< (list 1 '> (compose #'rot-cw #'rot-cw #'cross-x)))
+           (v (list 4 'v #'cross-y))
+           (^ (list 2 '> (compose #'rot-ccw #'rot-ccw #'rot-ccw #'cross-y)))))
+      (4 (case direction
+           (> (list 6 '^ (compose #'rot-ccw #'cross-x)))
+           (< (list 1 'v (compose #'rot-ccw #'cross-x)))
+           (v (list 5 'v #'cross-y))
+           (^ (list 3 '^ #'cross-y))))
+      (5 (case direction
+           (> (list 6 '< (compose #'rot-ccw #'rot-ccw #'cross-x)))
+           (< (list 1 '< #'cross-x))
+           (v (list 2 '< (compose #'rot-cw #'cross-y)))
+           (^ (list 4 '^ #'cross-y))))
+      (6 (case direction
+           (> (list 5 '< (compose #'rot-cw #'rot-cw #'cross-x)))
+           (< (list 3 '< #'cross-x))
+           (v (list 4 '< (compose #'rot-cw #'cross-y)))
+           (^ (list 2 '^  #'cross-y)))))))
 
-(defun cube-step (state face-length)
-  (destructuring-bind (face x-coord y-coord) (reduced-coords state face-length)
+(defun cube-step (state face-length jumper faces)
+  (destructuring-bind (face x-coord y-coord) (reduced-coords state face-length faces)
     (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)
+            (place-state face new-x new-y direction face-length faces)
+            (destructuring-bind (new-face new-direction pos-fn) (funcall jumper 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))))))))
+                (place-state new-face new-x new-y new-direction face-length faces))))))))
 
 (defun copy-clear-field (field)
   (destructuring-bind (height width) (array-dimensions field)
@@ -212,8 +258,8 @@
               (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)))))
+  (fiveam:is (= 1 (coord->face 2 0 +face-label+)))
+  (fiveam:is (= 6 (apply #'coord->face (append (face->coord 6 +face-label+) (list +face-label+))))))
 
 ;; (let* ((field (create-field "eg-in"))
 ;;        (face-length (floor (array-dimension field 0) 3)))
@@ -222,30 +268,46 @@
 ;;            (cube-advance (place-state 1 0 0 '^ face-length) face-length))))
 
 (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)
-        (let ((origin (place-state (1+ i) 0 0 '^ face-length)))
-          (fiveam:is (equalp origin
-                             (traverse field '(1 left 1 left 1 left)
-                                       origin #'advance-fn)))))
-      ;; walk all dirs straight
-      (dolist (dir '(> v < ^))
-        (fiveam:is (check (place-state 1 2 1 dir face-length) '(16)))))))
+  ;; (let ((field (copy-clear-field (create-field "eg-in")))
+  ;;       (face-length 4)))
+  (loop for (field face-length faces jumper) in (list (list (copy-clear-field (create-field "eg-in")) 4 +face-label+ #'face-jump)
+                                                 (list (copy-clear-field (create-field "input")) 50 '((1 . (0 2))
+                                                                                                      (2 . (0 3))
+                                                                                                      (3 . (1 0))
+                                                                                                      (4 . (1 1))
+                                                                                                      (5 . (1 2))
+                                                                                                      (6 . (2 0))) #'problem-face-jump))
+        do (labels ((advance-fn (state field)
+                      (declare (ignore field))
+                      (cube-step state face-length jumper faces))
+                    (check (origin moves)
+                      (equalp origin
+                              (traverse field moves
+                                        origin #'advance-fn))))
+             ;; around corners
+             (dotimes (i 6)
+               (let ((origin (place-state (1+ i) 0 0 '^ face-length faces)))
+                 (fiveam:is (equalp origin
+                                    (traverse field '(1 left 1 left 1 left)
+                                              origin #'advance-fn)))))
+             ;; walk all dirs straight
+             (dolist (dir '(> v < ^))
+               (fiveam:is (check (place-state 1 2 1 dir face-length faces) (list (* 4 face-length))))))))
 
 (fiveam:test solutions
   (fiveam:is (= 6032 (solver "eg-in" #'wrap-step)))
   (fiveam:is (= 159034 (solver "input" #'wrap-step)))
   ;part 2
-  (fiveam:is (= 5031 (solver "eg-in" (lambda (state field) (declare (ignore field)) (cube-step state 4))))))
+  (fiveam:is (= 5031 (solver "eg-in" (lambda (state field) (declare (ignore field)) (cube-step state 4 #'face-jump +face-label+))))))
+
+(let ((+face-label+
+        '((1 . (0 2))
+          (2 . (0 3))
+          (3 . (1 0))
+          (4 . (1 1))
+          (5 . (1 2))
+          (6 . (2 0)))))
+  (solver "input" (lambda (state field) (declare (ignore field)) (cube-step state 50 #'problem-face-jump +face-label+))))
 
 ;; (solver "input" (lambda (state field) (cube-step state 50)))
 
@@ -257,7 +319,6 @@
 ;;             (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")