aboutsummaryrefslogtreecommitdiffstats
path: root/AoC2023/day14
diff options
context:
space:
mode:
Diffstat (limited to 'AoC2023/day14')
-rw-r--r--AoC2023/day14/solve.lisp76
-rw-r--r--AoC2023/day14/solver.lisp106
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))))