aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorOscar Najera <hi@oscarnajera.com>2023-01-16 02:50:57 +0100
committerOscar Najera <hi@oscarnajera.com>2023-01-16 02:50:57 +0100
commit053580e6dc65ac1a80764294c8472a807099997f (patch)
treebd0c15b5e3ccf1f4480772232b04ab3b32e2986c
parent4c42cc4977e43ba1f6d9a1d184d8812a5653542d (diff)
downloadscratch-053580e6dc65ac1a80764294c8472a807099997f.tar.gz
scratch-053580e6dc65ac1a80764294c8472a807099997f.tar.bz2
scratch-053580e6dc65ac1a80764294c8472a807099997f.zip
Solved day 22 part 2
This looks horrible and solution path is hard coded
-rw-r--r--AoC2022/22/solver.lisp131
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")