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

(defun in-bounds (field crucible)
  (destructuring-bind (maxrow maxcol) (array-dimensions field)
    (destructuring-bind (dir row col) crucible
      (declare (ignorable dir))
      (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))))

(defstruct (walker (:copier nil))
  (path (make-hash-table :test #'equal))
  dir row col
  (track 0))

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

(defun next-direction (walker adv)
  (with-slots (path dir track) walker
    (destructuring-bind (move nrow ncol) adv
      (let ((np (alexandria:copy-hash-table path)))
        (setf (gethash adv np) t)
        (make-walker :path np
                     :dir move
                     :row nrow
                     :col ncol
                     :track (if (eq move dir) (1+ track) 0))))))

(defun next-moves (field tried walker)
  (with-slots (dir row col track) walker
    (arrows:->>
     (remove dir '(rt dw lf up) :key #'backtrack)
     (remove-if (lambda (d) (and (eq d dir)
                                 (<= 2 track))))
     (mapcar (alexandria:curry #'advance row col))
     (remove-if-not (alexandria:curry #'in-bounds field))
     (remove-if (lambda (p)
                  (gethash (cons (if (eq (car p) dir) (1+ track) 0) p) tried)))
     (mapcar (lambda (p)
               (let ((nt (if (eq (car p) dir) (1+ track) 0)))
                 (setf (gethash (cons nt p) tried) t)
                 (next-direction walker p)
                 ;; (destructuring-bind (dir row col) p
                 ;;   (make-walker :dir dir :row row :col col :track nt))
                 )))
     ;; (mapcar (lambda (d) (next-direction walker d)))
     )))

(defun finish-p (field step)
  (destructuring-bind (maxrow maxcol) (array-dimensions field)
    (with-slots (row col) step
      (and (= row (1- maxrow))
           (= col (1- maxcol))))))
(defun path-cost (field walker)
  (let ((cost 0))
    (maphash (lambda (k v)
               (declare (ignorable v))
               (destructuring-bind (dir row col) k
                 (declare (ignorable dir))
                 (incf cost (aref field row col))))
             (walker-path walker))
    cost))


(defun try (options known field iters)
  (let ((next (cl-heap:dequeue options)))
    ;; (with-slots (dir row col) next
    ;;   (format t "i: ~d cost: ~d/~d p: ~a~%" iters (path-cost field next) (hash-table-count (walker-path next)) (list dir row col)))
    (when next
      (if (finish-p field next)
          (progn (format t "Took ~d iters\n" iters)
                 next)
          (progn
            (dolist (newm (next-moves field known next))
              (cl-heap:enqueue options
                               newm
                               (path-cost field newm)))
            ;; (print (cl-heap:queue-size options))
            (try options known field (1+ iters))))))


  )

(let* ((field (parse-input "input"))
       ;; (maxloss (apply #'* 9 (array-dimensions field)))
       (options (make-instance 'cl-heap:priority-queue))
       (known (make-hash-table :test #'equal))
       (w (make-walker :dir 'rt :row 0 :col 0)))
  ;; (setf (gethash '(rt 0 0) (walker-path w)) 1)
  ;; (next-moves field w)
  ;; (carry field w maxloss 0)
  ;; (cl-heap:dequeue
  ;;  options)
  (cl-heap:enqueue options w 0)
  ;; (cl-heap:enqueue options '(rt 0 0 0) 0)
  ;; options
  ;; (print)
  (time
   (let ((r
           (try options known field 0)))
     (list (path-cost field r) r)))
  )

;; (let ( (w (make-walker :dir 'rt :row 0 :col 0))
;;        (y (make-walker :dir 'rt :row 0 :col 0)) )
;;   (equalp w y))
;; (make-hash-table :test #'equalp)