diff options
| -rw-r--r-- | AoC2022/22/solver.lisp | 74 |
1 files changed, 49 insertions, 25 deletions
diff --git a/AoC2022/22/solver.lisp b/AoC2022/22/solver.lisp index ca4b83e..b3ea61d 100644 --- a/AoC2022/22/solver.lisp +++ b/AoC2022/22/solver.lisp @@ -29,12 +29,6 @@ (#\Space nil))))) (values field (parse-instructions instructions)))) - -(defun get-start (field) - (loop for i from 0 - until (aref field 0 i) - finally (return i))) - (defstruct state x-pos y-pos direction) @@ -71,6 +65,13 @@ (free (walk field new-state (1- steps) advance-fn)) (wall state)))))) +(defun traverse (field instructions origin advance-fn) + (let ((state (copy-structure origin))) + (dolist (move instructions state) + (if (numberp move) + (setf state (walk field state move advance-fn)) + (setf (state-direction state) (new-direction (state-direction state) move)))))) + (defun decode-state (state) (with-slots (x-pos y-pos direction) state (+ (* 1000 (1+ y-pos)) @@ -81,14 +82,15 @@ (< 2) (^ 3))))) +(defun get-start (field) + (loop for i from 0 + until (aref field 0 i) + finally (return i))) + (defun solver (filename advance-fn) (multiple-value-bind (field instructions) (create-field filename) - (let ((state (make-state :x-pos (get-start field) :y-pos 0 :direction '>))) - (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)))) + (decode-state + (traverse field instructions (make-state :x-pos (get-start field) :y-pos 0 :direction '>) advance-fn)))) ;;; part 2 ;;; Cube face layout @@ -111,6 +113,7 @@ (5 . (2 2)) (6 . (3 2)))) + (defun coord->face (x-face y-face) (car (rassoc (list x-face y-face) +face-label+ :test #'equal))) @@ -177,16 +180,12 @@ (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-step state face-length)) - (setf (state-direction state) (new-direction (state-direction state) move)))) - (equalp orig state))) +(defun copy-clear-field (field) + (destructuring-bind (height width) (array-dimensions field) + (let ((new-field (make-array (list height width) :initial-element nil))) + (loop for y below height + do (loop for x below width when (aref field y x) do (setf (aref new-field y x) 'free))) + new-field))) (fiveam:test preparation (fiveam:is (eq 'v (new-direction '> 'right))) @@ -204,9 +203,23 @@ ;; (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 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) + (fiveam:is (check (place-state (1+ i) 0 0 '^ face-length) + '(1 left 1 left 1 left)))) + ;; walk all dirs straight + (dolist (dir '(> v < ^)) + (fiveam:is (check (place-state 1 2 1 dir face-length) '(16))))))) (fiveam:test solutions (fiveam:is (= 6032 (solver "eg-in" #'wrap-step))) @@ -217,6 +230,17 @@ ;; (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))) + +;; ))) + +;; (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) |