1 files changed, 106 insertions, 0 deletions
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))))