diff options
Diffstat (limited to 'AoC2022/22')
| -rw-r--r-- | AoC2022/22/solver.lisp | 131 |
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") |