(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