From 9946f703582b558089b0f33d36b69c65f4eba2ad Mon Sep 17 00:00:00 2001 From: Matteo Landi Date: Fri, 2 Feb 2024 22:38:56 +0100 Subject: [PATCH] Refactor 2023/14 --- src/2023/day14.lisp | 70 +++++++++++++++++++++++++-------------------- 1 file changed, 39 insertions(+), 31 deletions(-) diff --git a/src/2023/day14.lisp b/src/2023/day14.lisp index 4c0e9cb..b6987a2 100644 --- a/src/2023/day14.lisp +++ b/src/2023/day14.lisp @@ -2,7 +2,12 @@ (in-package :aoc/2023/14) -(defun parse-input (&optional (strings (uiop:read-file-lines #P"src/2023/day14.txt"))) +(defparameter *north* '(-1 0)) +(defparameter *east* '(0 1)) +(defparameter *south* '(1 0)) +(defparameter *west* '(0 -1)) + +(defun parse-input (&optional (strings (aoc::read-problem-input 2023 14))) (bnd* ((rows (length strings)) (cols (length (first strings))) (rocks (make-hash-table :test 'equal)) @@ -11,24 +16,31 @@ (doseq ((j ch) (enumerate s)) (when (char= ch #\O) (setf (gethash (list i j) rocks) ch)) - (when (char= ch #\# ) + (when (char= ch #\#) (setf (gethash (list i j) walls) ch)))) (list rocks walls rows cols))) + (defun north-first? (pos1 pos2) (< (first pos1) (first pos2))) +(defun west-first? (pos1 pos2) (< (second pos1) (second pos2))) +(defun south-first? (pos1 pos2) (> (first pos1) (first pos2))) +(defun east-first? (pos1 pos2) (> (second pos1) (second pos2))) + (defun move (dir sort-predicate &optional (input (parse-input))) (destructuring-bind (rocks walls rows cols) input - (dolist (pos (sort (hash-table-keys rocks) sort-predicate)) - (bnd1 (npos (mapcar #'+ pos dir)) - (while (not (or (gethash npos walls) - (gethash npos rocks) - (< (first npos) 0) (>= (first npos) rows) - (< (second npos) 0) (>= (second npos) cols))) - (remhash pos rocks) - (setf (gethash npos rocks) #\O - pos npos - npos (mapcar #'+ pos dir)))))) + (flet ((outside? (pos) + (or (< (first pos) 0) (>= (first pos) rows) + (< (second pos) 0) (>= (second pos) cols)))) + (dolist (pos (sort (hash-table-keys rocks) sort-predicate)) + (bnd1 (npos (mapcar #'+ pos dir)) + (while (not (or (gethash npos walls) + (gethash npos rocks) + (outside? npos))) + (remhash pos rocks) + (setf (gethash npos rocks) #\O + pos npos + npos (mapcar #'+ pos dir))))))) input) @@ -38,22 +50,13 @@ (reduce #'+ (hash-table-keys rocks) :key [- rows (car _)]))) -(defun part1 (&optional (input (parse-input))) - (move (list -1 0) #'north-first? input) - (north-load input)) - - -(defun west-first? (pos1 pos2) (< (second pos1) (second pos2))) -(defun south-first? (pos1 pos2) (> (first pos1) (first pos2))) -(defun east-first? (pos1 pos2) (> (second pos1) (second pos2))) - (defun cycle (&optional (input (parse-input))) - (move (list -1 0) #'north-first? input) - (move (list 0 -1) #'west-first? input) - (move (list 1 0) #'south-first? input) - (move (list 0 1) #'east-first? input)) + (move *north* #'north-first? input) + (move *west* #'west-first? input) + (move *south* #'south-first? input) + (move *east* #'east-first? input)) -(defun part2 (&optional (input (parse-input))) +(defun spin-cycle (n &optional (input (parse-input))) (destructuring-bind (cycles-at cycle-size input) (floyd #'cycle input :copier (lambda (state) @@ -63,17 +66,22 @@ rows cols))) :key (lambda (state) - (destructuring-bind (rocks walls rows cols) state + (destructuring-bind (rocks _ rows cols) state + (declare (ignore _)) (looping (dorange (i 0 rows) (dorange (j 0 cols) (when (gethash (list i j) rocks) (collect! (list i j)))))))) :test 'equalp) - (bnd1 (rem-steps (rem (- 1000000000 cycles-at) cycle-size)) + (bnd1 (rem-steps (rem (- n cycles-at) cycle-size)) (repeat rem-steps (cycle input)) - (north-load input)))) + input))) + + +(define-solution (2023 14) (input parse-input) + (values (north-load (move *north* #'north-first? input)) + (north-load (spin-cycle 1000000000 input)))) -#+#:excluded (time (part2)) -;; 112452 +(define-test (2023 14) (109345 112452))