From 6922fd9364d409c00822e897ad59706a1797c82a Mon Sep 17 00:00:00 2001 From: Oscar Najera Date: Mon, 23 Jan 2023 21:10:10 +0100 Subject: Clean up a bit --- AoC2022/22/solver.lisp | 128 +++++++++++++++++++------------------------------ 1 file changed, 48 insertions(+), 80 deletions(-) (limited to 'AoC2022') diff --git a/AoC2022/22/solver.lisp b/AoC2022/22/solver.lisp index 8f7b598..d8607c8 100644 --- a/AoC2022/22/solver.lisp +++ b/AoC2022/22/solver.lisp @@ -16,7 +16,7 @@ (map (butlast data 2)) (instructions (car (last data))) (rows (length map)) - (columns (reduce (lambda (a r) (max a (length r))) map :initial-value 0)) + (columns (loop for r in map maximize (length r))) (field (make-array (list rows columns) :initial-element nil))) (loop for row in map for i from 0 @@ -27,7 +27,7 @@ (#\. 'free) (#\# 'wall) (#\Space nil))))) - (values field (parse-instructions instructions)))) + (list field (parse-instructions instructions)))) (defstruct state x-pos y-pos direction) @@ -46,7 +46,7 @@ new-state (wrap-step new-state field))))))) -(defun new-direction (current-direction turn &optional (directions #(^ > v <))) +(defun new-direction (current-direction turn &aux (directions #(^ > v <))) (svref directions (mod (+ @@ -88,7 +88,7 @@ finally (return i))) (defun solver (filename advance-fn) - (multiple-value-bind (field instructions) (create-field filename) + (destructuring-bind (field instructions) (create-field filename) (decode-state (traverse field instructions (make-state :x-pos (get-start field) :y-pos 0 :direction '>) advance-fn)))) @@ -105,7 +105,7 @@ ;;; 5=2 2 ;;; 6=3 2 -(defparameter +face-label+ +(defparameter *example-faces* '((1 . (2 0)) (2 . (0 1)) (3 . (1 1)) @@ -142,17 +142,18 @@ ;;|↳→⬏↑ ;;↳→→→⬏ +(defun compose (&rest funcs) + (reduce (lambda (f g) + (lambda (&rest args) + (apply f (apply g args)))) + funcs)) + (defun 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))) + (cross-y (x y) (list x (- fl 1 y)))) (ecase face (1 (case direction (> (list 6 '< (compose #'rot-cw #'rot-cw #'cross-x))) @@ -184,21 +185,27 @@ (< (list 5 '< #'cross-x)) (v (list 2 '> (compose #'rot-ccw #'cross-y))) (^ (list 4 '< (compose #'rot-ccw #'cross-y)))))))) + +;;; Cube face layout ;; 36 ;; 4 ;; 15 ;; 2 + +(defparameter *problem-faces* + '((1 . (0 2)) + (2 . (0 3)) + (3 . (1 0)) + (4 . (1 1)) + (5 . (1 2)) + (6 . (2 0)))) + (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))) + (cross-y (x y) (list x (- fl 1 y)))) (ecase face (1 (case direction (> (list 5 '> #'cross-x)) @@ -258,74 +265,35 @@ (parse-instructions "10R5L5R10L4R5L5" ) '(10 RIGHT 5 LEFT 5 RIGHT 10 LEFT 4 RIGHT 5 LEFT 5))) - (fiveam:is (= 1 (coord->face 2 0 +face-label+))) - (fiveam:is (= 6 (apply #'coord->face (append (face->coord 6 +face-label+) (list +face-label+)))))) + (fiveam:is (= 1 (coord->face 2 0 *example-faces*))) + (fiveam:is (= 6 (apply #'coord->face (append (face->coord 6 *example-faces*) (list *example-faces*)))))) -;; (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)))) +(defun cube-stepper (jumper faces face-length) + (lambda (state field) (declare (ignore field)) + (cube-step state face-length jumper faces))) (fiveam:test around-cube - ;; (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)))))))) + (loop for (field jumper faces face-length) in (list (list (copy-clear-field (car (create-field "eg-in"))) + #'face-jump *example-faces* 4) + (list (copy-clear-field (car (create-field "input"))) + #'problem-face-jump *problem-faces* 50)) + do (flet ((check (origin moves advance-fn) + (equalp origin + (traverse field moves + origin advance-fn)))) + (dotimes (i 6) ;; on each face + (let ((origin (place-state (1+ i) 0 0 '^ face-length faces)) + (stepper (cube-stepper jumper faces face-length))) + ;; around corners + (fiveam:is (check origin '(1 left 1 left 1 left) stepper)) + ;; walk all dirs straight + (dolist (dir '(> v < ^)) + (fiveam:is (check origin (list (* 4 face-length)) stepper)))))))) (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 #'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))) - -;; (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))) -;; ))) + ;; part 2 + (fiveam:is (= 5031 (solver "eg-in" (cube-stepper #'face-jump *example-faces* 4)))) + (fiveam:is (= 147245 (solver "input" (cube-stepper #'problem-face-jump *problem-faces* 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))) -- cgit v1.2.3