Clean up a bit

1 files changed, 48 insertions, 80 deletions

diff --git a/AoC2022/22/solver.lisp b/AoC2022/22/solver.lisp
index 8f7b598..d8607c8 100644
--- a/AoC2022/22/solver.lisp
+++ b/AoC2022/22/solver.lisp
@@ -16,7 +16,7 @@
          (map (butlast data 2))
          (instructions (car (last data)))
          (rows (length map))
-         (columns (reduce (lambda (a r) (max a (length r))) map :initial-value 0))
+         (columns (loop for r in map maximize (length r)))
          (field (make-array (list rows columns) :initial-element nil)))
     (loop for row in map
           for i from 0
@@ -27,7 +27,7 @@
                               (#\. 'free)
                               (#\# 'wall)
                               (#\Space nil)))))
-    (values field (parse-instructions instructions))))
+    (list field (parse-instructions instructions))))
 
 (defstruct state
   x-pos y-pos direction)
@@ -46,7 +46,7 @@
               new-state
               (wrap-step new-state field)))))))
 
-(defun new-direction (current-direction turn &optional (directions #(^ > v <)))
+(defun new-direction (current-direction turn &aux (directions #(^ > v <)))
   (svref directions
          (mod
           (+
@@ -88,7 +88,7 @@
         finally (return i)))
 
 (defun solver (filename advance-fn)
-  (multiple-value-bind (field instructions) (create-field filename)
+  (destructuring-bind (field instructions) (create-field filename)
     (decode-state
      (traverse field instructions (make-state :x-pos (get-start field) :y-pos 0 :direction '>) advance-fn))))
 
@@ -105,7 +105,7 @@
 ;;; 5=2 2
 ;;; 6=3 2
 
-(defparameter +face-label+
+(defparameter *example-faces*
   '((1 . (2 0))
     (2 . (0 1))
     (3 . (1 1))
@@ -142,17 +142,18 @@
 ;;|↳→⬏↑
 ;;↳→→→⬏
 
+(defun compose (&rest funcs)
+  (reduce (lambda (f g)
+            (lambda (&rest args)
+              (apply f (apply g args))))
+          funcs))
+
 (defun 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)))
+         (cross-y (x y) (list x  (- fl 1 y))))
     (ecase face
       (1 (case direction
            (> (list 6 '< (compose #'rot-cw #'rot-cw #'cross-x)))
@@ -184,21 +185,27 @@
            (< (list 5 '< #'cross-x))
            (v (list 2 '> (compose #'rot-ccw #'cross-y)))
            (^ (list 4 '< (compose #'rot-ccw #'cross-y))))))))
+
+;;; Cube face layout
 ;;  36
 ;;  4
 ;; 15
 ;; 2
+
+(defparameter *problem-faces*
+  '((1 . (0 2))
+    (2 . (0 3))
+    (3 . (1 0))
+    (4 . (1 1))
+    (5 . (1 2))
+    (6 . (2 0))))
+
 (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)))
+         (cross-y (x y) (list x  (- fl 1 y))))
     (ecase face
       (1 (case direction
            (> (list 5 '> #'cross-x))
@@ -258,74 +265,35 @@
               (parse-instructions "10R5L5R10L4R5L5" )
               '(10 RIGHT 5 LEFT 5 RIGHT 10 LEFT 4 RIGHT 5 LEFT 5)))
 
-  (fiveam:is (= 1 (coord->face 2 0 +face-label+)))
-  (fiveam:is (= 6 (apply #'coord->face (append (face->coord 6 +face-label+) (list +face-label+))))))
+  (fiveam:is (= 1 (coord->face 2 0 *example-faces*)))
+  (fiveam:is (= 6 (apply #'coord->face (append (face->coord 6 *example-faces*) (list *example-faces*))))))
 
-;; (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))))
+(defun cube-stepper (jumper faces face-length)
+  (lambda (state field) (declare (ignore field))
+    (cube-step state face-length jumper faces)))
 
 (fiveam:test around-cube
-  ;; (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))))))))
+  (loop for (field jumper faces face-length) in (list (list (copy-clear-field (car (create-field "eg-in")))
+                                                            #'face-jump *example-faces* 4)
+                                                      (list (copy-clear-field (car (create-field "input")))
+                                                            #'problem-face-jump *problem-faces* 50))
+        do (flet ((check (origin moves advance-fn)
+                    (equalp origin
+                            (traverse field moves
+                                      origin advance-fn))))
+             (dotimes (i 6) ;; on each face
+               (let ((origin (place-state (1+ i) 0 0 '^ face-length faces))
+                     (stepper (cube-stepper jumper faces face-length)))
+                 ;; around corners
+                 (fiveam:is (check origin '(1 left 1 left 1 left) stepper))
+                 ;; walk all dirs straight
+                 (dolist (dir '(> v < ^))
+                   (fiveam:is (check origin (list (* 4 face-length)) stepper))))))))
 
 (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 #'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)))
-
-;; (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)))
-;;       )))
+  ;; part 2
+  (fiveam:is (= 5031 (solver "eg-in" (cube-stepper #'face-jump *example-faces* 4))))
+  (fiveam:is (= 147245 (solver "input" (cube-stepper #'problem-face-jump *problem-faces* 50)))))
 
-;; (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)
-;;         (if (numberp move)
-;;             (setf state (walk field state move advance-fn))
-;;             (setf (state-direction state) (new-direction (state-direction state) move))))
-;;       (decode-state state)))