diff options
| -rw-r--r-- | AoC2022/22/solver.lisp | 64 |
1 files changed, 37 insertions, 27 deletions
diff --git a/AoC2022/22/solver.lisp b/AoC2022/22/solver.lisp index 062e441..ca4b83e 100644 --- a/AoC2022/22/solver.lisp +++ b/AoC2022/22/solver.lisp @@ -38,21 +38,21 @@ (defstruct state x-pos y-pos direction) -(defun advance (field state) +(defun wrap-step (state field) (destructuring-bind (height width) (array-dimensions field) (with-slots (direction x-pos y-pos) state (destructuring-bind (new-x new-y) (ecase direction - (north (list x-pos (mod (1- y-pos) height))) - (south (list x-pos (mod (1+ y-pos) height))) - (east (list (mod (1+ x-pos) width) y-pos)) - (west (list (mod (1- x-pos) width) y-pos))) + (^ (list x-pos (mod (1- y-pos) height))) + (v (list x-pos (mod (1+ y-pos) height))) + (> (list (mod (1+ x-pos) width) y-pos)) + (< (list (mod (1- x-pos) width) 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 - (advance field new-state))))))) + (wrap-step new-state field))))))) -(defun new-direction (current-direction turn &optional (directions #(north east south west))) +(defun new-direction (current-direction turn &optional (directions #(^ > v <))) (svref directions (mod (+ @@ -62,32 +62,31 @@ (position current-direction directions)) 4))) -(defun walk (field state steps) +(defun walk (field state steps advance-fn) (if (zerop steps) state - (let ((new-state (advance field state))) + (let ((new-state (funcall advance-fn state field))) (with-slots (x-pos y-pos) new-state (ecase (aref field y-pos x-pos) - (free (walk field new-state (1- steps))) + (free (walk field new-state (1- steps) advance-fn)) (wall state)))))) - (defun decode-state (state) (with-slots (x-pos y-pos direction) state (+ (* 1000 (1+ y-pos)) (* 4 (1+ x-pos)) (ecase direction - (east 0) - (south 1) - (west 2) - (north 3))))) + (> 0) + (v 1) + (< 2) + (^ 3))))) -(defun solver (filename) +(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 'east))) + (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)) + (setf state (walk field state move advance-fn)) (setf (state-direction state) (new-direction (state-direction state) move)))) (decode-state state)))) @@ -165,7 +164,7 @@ (< (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) +(defun cube-step (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)))) @@ -185,15 +184,13 @@ (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) - ) + (setf state (cube-step state face-length)) + (setf (state-direction state) (new-direction (state-direction state) move)))) (equalp orig state))) (fiveam:test preparation - (fiveam:is (eq 'south (new-direction 'east 'right))) - (fiveam:is (eq 'west (new-direction 'north 'left))) + (fiveam:is (eq 'v (new-direction '> 'right))) + (fiveam:is (eq '< (new-direction '^ 'left))) (fiveam:is (equal (parse-instructions "10R5L5R10L4R5L5" ) '(10 RIGHT 5 LEFT 5 RIGHT 10 LEFT 4 RIGHT 5 LEFT 5))) @@ -212,5 +209,18 @@ (fiveam:is (around-corner-test (1+ i) 4)))) (fiveam:test solutions - (fiveam:is (= 6032 (solver "eg-in"))) - (fiveam:is (= 159034 (solver "input")))) + (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) (cube-step state 4)))))) + +;; (solver "input" (lambda (state field) (cube-step state 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))) |