full spin

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!)