diff options
Diffstat (limited to 'AoC2023')
-rw-r--r-- | AoC2023/day14/solve.lisp | 70 |
1 files changed, 58 insertions, 12 deletions
diff --git a/AoC2023/day14/solve.lisp b/AoC2023/day14/solve.lisp index 5c463a2..9f9d6e8 100644 --- a/AoC2023/day14/solve.lisp +++ b/AoC2023/day14/solve.lisp @@ -3,33 +3,79 @@ ;; (ql:quickload '(fiveam)) -(defun roll-rocks (field) - (loop for row from 1 below (array-dimension field 0) +(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 row below (array-dimension field 0) sum (loop for col below (array-dimension field 1) - when (and (eq #\O (aref field row col)) - (eq #\. (aref field (1- row) col))) - do (setf (aref field (1- row) col) #\O + for (new-row new-col) = (roll direction row col) + when (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) #\.) and count t))) +(defun roll-rocks-full (field direction) + (loop + for result = (roll-rocks field direction) + until (zerop result))) + (defun array-slice (arr row) (make-array (array-dimension arr 1) :displaced-to arr :displaced-index-offset (* row (array-dimension arr 1)))) -(defun solve (input) +(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-full field 'north) + (north-load field))) + +(defun draw-field (field) + (destructuring-bind (maxrow maxcol) (array-dimensions field) + (with-output-to-string (out) + + (loop for i below maxrow do + (loop for j below maxcol do + (write-char (aref field i j) out)) + (terpri out))))) + +(defun solve2 (input iters) (let* ((rows (length input)) (field (make-array (list rows (length (car input))) :initial-contents input))) (loop - for result = (roll-rocks field) - until (zerop result)) - (loop for row below rows - sum (* (- rows row) (count #\O (array-slice field row)))))) + 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 (solve (uiop:read-file-lines "eg-in")))) - (fiveam:is (= 108935 (solve (uiop:read-file-lines "input"))))) + (fiveam:is (= 136 (solve1 (uiop:read-file-lines "eg-in")))) + (fiveam:is (= 108935 (solve1 (uiop:read-file-lines "input"))))) (fiveam:run!) |