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