;;05:32

(ql:quickload '(fiveam arrows))

(defparameter directions
  '((up -1 0)
    (dw  1 0)
    (lf 0 -1)
    (rt 0  1)))

(defparameter pipes
  '((#\| up dw)
    (#\- lf rt)
    (#\L up rt)
    (#\J up lf)
    (#\7 dw lf)
    (#\F dw rt)
    (#\.)
    (#\S up dw lf rt)))

(defparameter eg-input
  "7-F7-
.FJ|7
SJLL7
|F--J
LJ.LJ")

(defun get-neighbors (point)
  (mapcar
   (lambda (dir)
     (cdr (assoc dir directions)))
   (cdr (assoc point pipes))))

(fiveam:test parts
  (fiveam:is (equal '((0 -1) (0 1))
                    (get-neighbors #\-))))


(defun find-start (map)
  (loop for row across map
        for y from 0 do
          (loop for col across row
                for x from 0
                when (eq #\S col)
                  do (return-from find-start (list y x)))))

(defun move-next (map point)
  (flet ((bounds (y x)
           (let ((ymax (length map))
                 (xmax (length (aref map 0))))
             (when (and (< -1 y ymax)
                        (< -1 x xmax))
               (list y x)))))
    (destructuring-bind (y x) point
      (loop for (dy dx) in (get-neighbors (aref (aref map y) x))
            when (bounds (+ y dy) (+ x dx)) collect it))))

(defun start-neighbors (map start)
  (remove-if-not
   (lambda (n)
     (member start (move-next map n) :test #'equal))
   (move-next map start)))

(defun advance-next (map point last)
  (let ((next (move-next map point)))
    (if (equal last (car next))
        (cadr next)
        (car next))))

(defun get-loop (map)
  (let* ((start (find-start map))
         (options (start-neighbors map start))
         (last start)
         (cur (car options))
         (loop-tiles (make-hash-table :test #'equal)))
    (setf (gethash cur loop-tiles) t)
    (loop
      for next = (advance-next map cur last)
      do (setf last cur
               cur next
               (gethash next loop-tiles) t)
      until (equal next start))
    loop-tiles))

(defun solver1 (rows)
  (let ((map (make-array (length rows) :initial-contents rows)))
    (floor (hash-table-count (get-loop map)) 2)))

;; To know if a point is inside a loop, I need to count how often a ray crosses
;; until it reaches the boundary. I can just count to the right.
;; In this case only the vertical edges count, and element that change direction.
;; Meaning LJ is a u, same as F7 an n, that means the ray passes tangent across
;; those 2 cells taking the point a bit lower, would mean only counting pipes
;; with down component thus F,|,7. The rest L,-,J are irrelevant.

(defun rassoc-get (list item)
  (car (rassoc item list :test #'equal)))

(defun correct-start (map)
  (let ((start (find-start map)))
    (arrows:->> (start-neighbors map start)
                (mapcar (lambda (point)
                          (destructuring-bind (y x) point
                            (list (- y (first start))
                                  (- x (second start))))))
                (mapcar (lambda (p) (rassoc-get directions p)))
                (rassoc-get pipes)
                (setf (aref (aref map (car start)) (cadr start))))))

(defun solver2 (rows)
  (let* ((map (make-array (length rows) :initial-contents rows))
         (loop-tiles (get-loop map))
         insidep)
    (correct-start map)
    (loop for row across map
          for y from 0
          for insidep = nil
          sum
          (loop for col across row
                for x from 0
                for point = (list y x)
                if (gethash point loop-tiles) do
                  (when (member col '(#\F #\| #\7))
                    (setf insidep (not insidep)))
                else count insidep))))

(fiveam:test solution
  (fiveam:is (= 8 (solver1 (uiop:split-string eg-input :separator '(#\Newline)))))
  (fiveam:is (= 6812 (solver1 (uiop:read-file-lines "input"))))
  (fiveam:is (= 1 (solver2 (uiop:split-string eg-input :separator '(#\Newline)))))
  (fiveam:is (= 527 (solver2 (uiop:read-file-lines "input")))))