day14 but rock rolling is string sorting

1 files changed, 72 insertions, 0 deletions

diff --git a/AoC2023/day14/solver2.lisp b/AoC2023/day14/solver2.lisp
new file mode 100644
index 0000000..08fb450
--- /dev/null
+++ b/AoC2023/day14/solver2.lisp
@@ -0,0 +1,72 @@
+;; 13:45
+(ql:quickload '(fiveam arrows str))
+
+(defun roll-to-west (line)
+  (arrows:->>
+   (str:split "#" line)
+   (mapcar (lambda (ranges) (sort ranges #'char>)))
+   (str:join "#")))
+
+(defun transpose-rows (rows)
+  (apply #'map 'list (lambda (&rest vals)
+                       (concatenate 'string vals)) rows))
+
+(defun north-load (field)
+  (loop
+    for row in field
+    for weight from (length field) downto 0
+    sum (* weight (count #\O row))))
+
+(defun solve1 (input)
+  (arrows:->>
+   input
+   (transpose-rows)
+   (mapcar #'roll-to-west)
+   (transpose-rows)
+   (north-load)))
+
+(defun cycle (field)
+  (loop repeat 4
+        do (arrows:->>
+            field
+            (transpose-rows)
+            (mapcar #'roll-to-west)
+            (mapcar #'nreverse)
+            (setf field)))
+  field)
+
+(defun value-hash (hash-table value)
+  (maphash (lambda (k v)
+             (when (equal v value)
+               (return-from value-hash k)))
+           hash-table))
+
+(defun solve2 (input max-cycles)
+  (let ((seen (make-hash-table :test #'equal))
+        first-in-series)
+    (loop repeat max-cycles
+          for i from 0
+          for field = input then (cycle field)
+          for strf = (str:join #\Newline field)
+          until (gethash strf seen)
+          do (setf (gethash strf seen) i)
+          finally (setf first-in-series strf))
+    (let* ((last (hash-table-count seen))
+           (first (gethash first-in-series seen))
+           (sp (+ first (rem (- max-cycles first) (- last first))))
+           (ss (value-hash seen sp)))
+
+      ;; (list last first seen
+      ;;       (rem (- max-cycles first) (- last first))
+      ;;       ss
+      ;;       sp)
+      (north-load (str:split #\Newline ss)))))
+
+(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))))
+
+(time
+ (fiveam:run!))