aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorOscar Najera <hi@oscarnajera.com>2023-01-23 21:10:10 +0100
committerOscar Najera <hi@oscarnajera.com>2023-01-23 21:10:10 +0100
commit6922fd9364d409c00822e897ad59706a1797c82a (patch)
tree5f67cf64503adf7019f352db84898722c35093a3
parent053580e6dc65ac1a80764294c8472a807099997f (diff)
downloadscratch-6922fd9364d409c00822e897ad59706a1797c82a.tar.gz
scratch-6922fd9364d409c00822e897ad59706a1797c82a.tar.bz2
scratch-6922fd9364d409c00822e897ad59706a1797c82a.zip
Clean up a bit
-rw-r--r--AoC2022/22/solver.lisp128
1 files changed, 48 insertions, 80 deletions
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)))