1 files changed, 73 insertions, 0 deletions
diff --git a/day14.lisp b/day14.lisp
new file mode 100644
index 0000000..346d1b4
--- /dev/null
+++ b/day14.lisp
@@ -0,0 +1,73 @@
+(defun read-lines (filespec)
+  (with-open-file (stream filespec)
+    (loop for line = (read-line stream nil)
+          while line
+          collect line)))
+
+(defun tilt-map-load (map)
+  (loop with lstpos = (make-array (length (first map)) :initial-element (1+ (length map)))
+        for line in map
+        for i = (length map) then (1- i)
+        sum (loop for c across line
+                  for j below (length line)
+                  sum (cond ((equal c #\O) (setf (aref lstpos j) (1- (aref lstpos j))))
+                            ((equal c #\#) (setf (aref lstpos j) i) 0)
+                            (t 0)))))
+
+(defun solve1 (filespec)
+  (let ((map (read-lines filespec)))
+    (tilt-map-load map)))
+
+(defun tilt-west (map)
+  (loop for line in map
+        do (loop with nxt = 0
+                 for c across line
+                 for j from 0
+                 when (equal c #\O)
+                   do (progn (when (/= nxt j)
+                               (setf (aref line nxt) #\O
+                                     (aref line j) #\.))
+                             (setf nxt (1+ nxt)))
+                 when (equal c #\#)
+                   do (setf nxt (1+ j))))
+  map)
+
+(defun rotate-clockwise (map)
+  (let ((map (reverse map)))
+    (loop for i below (length (first map))
+          collect (coerce (loop for line in map collect (aref line i)) '(string)))))
+
+(defun rotate-counter-clockwise (map)
+  (loop for i = (1- (length (first map))) then (1- i)
+        while (>= i 0)
+        collect (coerce (loop for line in map collect (aref line i)) '(string))))
+
+(defun map-load (map)
+  (loop for i = (length map) then (1- i)
+        for line in map
+        sum (loop for c across line
+                  when (equal c #\O)
+                    sum i)))
+
+(defun solve2 (filespec &optional (cycles 1000000000))
+  (let ((map (read-lines filespec))
+        (tab (make-hash-table :test #'equalp)))
+    (loop for i below cycles
+          do (progn (setf map (rotate-counter-clockwise map))
+                    (loop repeat 4
+                          do (setf map (rotate-clockwise (tilt-west map))))
+                    (setf map (rotate-clockwise map)))
+          until (multiple-value-bind (val found-p) (gethash map tab)
+                  (let ((prev (if found-p val (setf (gethash map tab) i))))
+                    (if (and (> i prev) (= 1 (mod (- cycles i) (- i prev)))) t nil))))
+    (map-load map)))
+
+(print (solve1 "data/14/example.txt")) ;; 136
+(print (solve1 "data/14/input.txt"))   ;; 109939
+(print (solve2 "data/14/example.txt")) ;; 64
+(print (solve2 "data/14/input.txt"))   ;; 101010
+
+        
+  
+
+