;; 11:45
;;
(ql:quickload '(fiveam arrows cl-heap))

(defun in-bounds (field position)
  (destructuring-bind (maxrow maxcol) (array-dimensions field)
    (destructuring-bind (row col) position
      (and (< -1 row maxrow)
           (< -1 col maxcol)))))

(defun advance (row col dir)
  (cons dir
        (ecase dir
          (up (list (1- row) col))
          (lf (list row (1- col)))
          (dw (list (1+ row) col))
          (rt (list row (1+ col))))))

(defun parse-input (filepath)
  (let* ((input (uiop:read-file-lines filepath))
         (rows (length input)))
    (make-array (list rows (length (car input)))
                :initial-contents
                (mapcar (lambda (line)
                          (map 'vector (lambda (c)
                                         (logand 15 (char-code c)))
                               line))
                        input))))

(defun backtrack (dir)
  (ecase dir
    (up 'dw)
    (rt 'lf)
    (dw 'up)
    (lf 'rt)))

(defun next-moves (field tried walker turn-condition)
  (destructuring-bind (track dir row col) walker
    (arrows:->>
     (remove dir '(rt dw lf up) :key #'backtrack)
     (mapcar (lambda (d)
               (let ((nt (if (eq d dir) (1+ track) 0)))
                 (when (funcall turn-condition d dir (1+ track))
                   (destructuring-bind (ndir . np) (advance row col d)
                     (when (in-bounds field np)
                       (let ((npath (list* nt ndir np)))
                         (unless (gethash npath tried)
                           (setf (gethash npath tried) t)
                           npath))))))))
     (delete nil))))

(defun finish-p (field step)
  (destructuring-bind (maxrow maxcol) (array-dimensions field)
    (destructuring-bind (row col) (cddr step)
      (and (= row (1- maxrow))
           (= col (1- maxcol))))))

(defun vdequeue (q)
  (cl-heap:pop-heap (slot-value q 'cl-heap:heap)))

(defun walk (options known field turn-condition)
  (loop for (pcost current) = (vdequeue options)
        while current
        until (finish-p field current)
        do (dolist (next (next-moves field known current turn-condition))
             (cl-heap:enqueue options next (+ (apply #'aref field (cddr next)) pcost)))
        finally (return pcost)))

(defun part1-turn (d dir track)
  (or (not (eq d dir)) (< track 3)))

(defun part2-turn (d dir track)
  (or (and (not (eq d dir))
           (>= track 4))
      (and (eq d dir)
           (< track 10))))

(defun solver (filename turn-condition)
  (let* ((field (parse-input filename))
         (options (make-instance 'cl-heap:priority-queue))
         (known (make-hash-table :test #'equal))
         (w (list 10 'rest 0 0)))
    (cl-heap:enqueue options w 0)
    (walk options known field turn-condition)))

(fiveam:test solutions
  (fiveam:is (= 102 (solver "eg-in" #'part1-turn)))
  (fiveam:is (= 963 (solver "input" #'part1-turn)))
  (fiveam:is (= 94  (solver "eg-in" #'part2-turn)))
  (fiveam:is (= 1178 (solver "input" #'part2-turn))))