aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorOscar Najera <hi@oscarnajera.com>2023-01-15 18:16:44 +0100
committerOscar Najera <hi@oscarnajera.com>2023-01-15 18:16:44 +0100
commit15bbaa69fb45a8e4fd7f25ac290665a58c9654e4 (patch)
tree2ef6630401a7b86e5a840c13f48ee55db3bf1e72
parent439b3f328c7fa55a6d7e1dc3637bbe19a244299a (diff)
downloadscratch-15bbaa69fb45a8e4fd7f25ac290665a58c9654e4.tar.gz
scratch-15bbaa69fb45a8e4fd7f25ac290665a58c9654e4.tar.bz2
scratch-15bbaa69fb45a8e4fd7f25ac290665a58c9654e4.zip
moving on cube surface
-rw-r--r--AoC2022/22/solver.lisp240
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"))))