diff options
| -rw-r--r-- | AoC2022/22/solver.lisp | 240 |
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")))) |