aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorOscar Najera <hi@oscarnajera.com>2023-01-15 21:28:29 +0100
committerOscar Najera <hi@oscarnajera.com>2023-01-15 21:36:17 +0100
commitcfeb6eaf52cfd6dd957c5716877e8ac0f4bea3a1 (patch)
tree61fbb61c519819f0961cd92625fe36232f697262
parent7a06cbc173ad19675d2b5b941705bf0ff35fe736 (diff)
downloadscratch-cfeb6eaf52cfd6dd957c5716877e8ac0f4bea3a1.tar.gz
scratch-cfeb6eaf52cfd6dd957c5716877e8ac0f4bea3a1.tar.bz2
scratch-cfeb6eaf52cfd6dd957c5716877e8ac0f4bea3a1.zip
walk cube
-rw-r--r--AoC2022/22/solver.lisp74
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)