diff options
Diffstat (limited to 'AoC2023/day14')
| -rw-r--r-- | AoC2023/day14/solve.lisp | 76 | ||||
| -rw-r--r-- | AoC2023/day14/solver.lisp | 106 |
2 files changed, 106 insertions, 76 deletions
diff --git a/AoC2023/day14/solve.lisp b/AoC2023/day14/solve.lisp deleted file mode 100644 index e476bd5..0000000 --- a/AoC2023/day14/solve.lisp +++ /dev/null @@ -1,76 +0,0 @@ -;; 9:39 start -;; 10:17 part 1 -;; -(ql:quickload '(fiveam)) - -(defun roll (direction row col) - (ecase direction - (north (list (1- row) col)) - (south (list (1+ row) col)) - (west (list row (1- col))) - (east (list row (1+ col))))) - -(defun in-bounds (field row col) - (destructuring-bind (maxrow maxcol) (array-dimensions field) - (and (< -1 row maxrow) - (< -1 col maxcol)))) - -(defun roll-rocks (field direction) - (loop for i below (array-dimension field 0) do - (loop for j below (array-dimension field 1) do - (loop - for (row col) = (list i j) then (list new-row new-col) - for (new-row new-col) = (roll direction row col) - while (and - (in-bounds field new-row new-col) - (eq #\O (aref field row col)) - (eq #\. (aref field new-row new-col))) - do (setf (aref field new-row new-col) #\O - (aref field row col) #\.))))) - -(defun array-slice (arr row) - (make-array (array-dimension arr 1) - :displaced-to arr - :displaced-index-offset (* row (array-dimension arr 1)))) - -(defun north-load (field) - (loop - with rows = (array-dimension field 0) - for row below rows - sum (* (- rows row) (count #\O (array-slice field row))))) - -(defun solve1 (input) - (let* ((rows (length input)) - (field - (make-array (list rows (length (car input))) :initial-contents input))) - (roll-rocks field 'north) - (north-load field))) - -(defun draw-field (field &optional (out *standard-output*)) - (destructuring-bind (maxrow maxcol) (array-dimensions field) - (loop for i below maxrow do - (loop for j below maxcol do - (write-char (aref field i j) out)) - (terpri out)) - (terpri out))) - -(defun solve2 (input iters) - (let* ((rows (length input)) - (field - (make-array (list rows (length (car input))) :initial-contents input))) - (loop - do (dolist (dir '(north west south east)) - (roll-rocks-full field dir)) - repeat iters - collect - (north-load field)))) - -;; (solve2 (uiop:read-file-lines "eg-in") 1000000000) -;; (solve2 (uiop:read-file-lines "eg-in") 100) -;; (solve2 (uiop:read-file-lines "input") 100) -(fiveam:test solutions - (fiveam:is (= 136 (solve1 (uiop:read-file-lines "eg-in")))) - (fiveam:is (= 108935 (solve1 (uiop:read-file-lines "input")))) - ) - -(fiveam:run!) diff --git a/AoC2023/day14/solver.lisp b/AoC2023/day14/solver.lisp new file mode 100644 index 0000000..dffadf7 --- /dev/null +++ b/AoC2023/day14/solver.lisp @@ -0,0 +1,106 @@ +;; 9:39 start +;; 10:17 part 1 +;; 13:23 part 2 +(ql:quickload '(fiveam)) + +(defun roll (direction row col) + (ecase direction + (north (list (1- row) col)) + (south (list (1+ row) col)) + (west (list row (1- col))) + (east (list row (1+ col))))) + +(defun edges-run (field direction) + (destructuring-bind (maxrow maxcol) (array-dimensions field) + (list + (alexandria:iota maxrow :start (if (eq direction 'south) (1- maxrow) 0) + :step (if (eq direction 'south) -1 1)) + (alexandria:iota maxcol :start (if (eq direction 'east) (1- maxcol) 0) + :step (if (eq direction 'east) -1 1))))) + + +(defun in-bounds (field row col) + (destructuring-bind (maxrow maxcol) (array-dimensions field) + (and (< -1 row maxrow) + (< -1 col maxcol)))) + +(defun roll-rocks (field direction) + (destructuring-bind (rows cols) (edges-run field direction) + (loop for i in rows do + (loop for j in cols do + (loop + for (row col) = (list i j) then (list new-row new-col) + for (new-row new-col) = (roll direction row col) + while (and + (in-bounds field new-row new-col) + (eq #\O (aref field row col)) + (eq #\. (aref field new-row new-col))) + do (setf (aref field new-row new-col) #\O + (aref field row col) #\.)))))) + +(defun array-slice (arr row) + (make-array (array-dimension arr 1) + :displaced-to arr + :displaced-index-offset (* row (array-dimension arr 1)))) + +(defun north-load (field) + (loop + with rows = (array-dimension field 0) + for row below rows + sum (* (- rows row) (count #\O (array-slice field row))))) + +(defun solve1 (input) + (let* ((rows (length input)) + (field + (make-array (list rows (length (car input))) :initial-contents input))) + (roll-rocks field 'north) + (north-load field))) + +(defun draw-field (field &optional (out *standard-output*)) + (destructuring-bind (maxrow maxcol) (array-dimensions field) + (loop for i below maxrow do + (loop for j below maxcol do + (write-char (aref field i j) out)) + (terpri out)) + (terpri out))) + +(defun find-series (list) + (let* ((len (length list)) + (half-length (floor len 2))) + (loop for span from 1 below half-length + when (equal + (subseq list (- len span) len) + (subseq list (- len (* span 2)) (- len span))) + do (return span)))) + +(defun spin (field iters) + (loop + do (dolist (dir '(north west south east)) + (roll-rocks field dir)) + repeat iters + collect + (north-load field))) + +(defun solve2 (input max-cycles) + (let* ((rows (length input)) + (field + (make-array (list rows (length (car input))) :initial-contents input))) + + (destructuring-bind (start series ls) + (loop + for cycle = 5 then (* 2 cycle) + append (spin field cycle) into serie + do + (alexandria:when-let ((has-serie (find-series serie))) + (return + (list (- (length serie) has-serie) + (subseq serie (- (length serie) has-serie)) + has-serie)))) + (elt series (1- (rem (- max-cycles start) ls)))))) + + +(fiveam:test solutions + (fiveam:is (= 136 (solve1 (uiop:read-file-lines "eg-in")))) + (fiveam:is (= 108935 (solve1 (uiop:read-file-lines "input")))) + (fiveam:is (= 64 (solve2 (uiop:read-file-lines "eg-in") 1000000000))) + (fiveam:is (= 100876(solve2 (uiop:read-file-lines "input") 1000000000)))) |