(defvar *required-tools-by-area-type '((0 climbing-gear torch)
                                       (1 climbing-gear NIL)
                                       (2 torch NIL)))

(defun cave-change-area (curr next target depth)
  (let* ((ctools (third curr))
         (ctime (fourth curr))
         (nx (first next))
         (ny (second next))
         (carea-type (area-type (first curr) (second curr) target depth))
         (narea-type (area-type nx ny target depth)))
    (if (equal carea-type narea-type)
      (list (list nx ny ctools (+ ctime 1)))
      (loop :for ntools in (rest (assoc narea-type *required-tools-by-area-type))
            :collecting (list
                          nx
                          ny
                          ntools
                          (+ ctime (if (equal ntools ctools) 1 8)))))))

(defun cave-neighbors (curr target depth)
  (let* ((x (first curr))
         (y (second curr))
         neighbors)
    (if (> y 0)
      (push (list x (- y 1)) neighbors))
    (push (list (+ x 1) y) neighbors)
    (push (list x (+ y 1)) neighbors)
    (if (> x 0)
      (push (list (- x 1) y) neighbors) neighbors)
    (reduce
      #'append
      (mapcar
        #'(lambda (n)
            (cave-change-area curr n target depth))
        neighbors))))

(defun cave-backtrack (curr come-from)
  (let ((key (format NIL "~d,~d,~a" (first curr) (second curr) (fourth curr))))
    (cond ((not (gethash key come-from)) (list curr))
          (T (cons curr (cave-backtrack (gethash key come-from) come-from))))))

(defun solve-day22-2 (depth target)
  (setf *geologic-index-cache* (make-hash-table :test 'equal))
  (let ((frontier (list '(0 0 0 torch 0 NIL))) ; priority x y tools time
        (cost-so-far (make-hash-table :test 'equal))
        (come-from (make-hash-table :test 'equal))
        best-at-target)
    (setf (gethash "0,0,TORCH" cost-so-far) 0)
    (loop :while frontier
          ; :do (format t "~A~%" (rest (first frontier)))
          :do (let* ((curr (rest (pop frontier)))
                     (at-target(and (equal (first curr) (first target))
                                    (equal (second curr) (second target)))))
                (if at-target
                  (let ((actual-time (+ (fourth curr)
                                        (if (equal (third curr) 'torch) 0 7))))
                    ; (progn (format t "~A~%" (reverse (cave-backtrack curr come-from))) (break))
                    (if best-at-target
                      (return (min best-at-target actual-time))
                      (setf best-at-target actual-time)))
                  (loop :for next :in (cave-neighbors curr target depth)
                        :do (let ((key (format NIL "~d,~d,~a" (first next) (second next) (third next))))
                              (when (or (null (gethash key cost-so-far))
                                        (< (fourth next)
                                           (gethash key cost-so-far)))
                                (let* ((priority (+ (fourth next)
                                                    (manhattan-distance-seq next target)))
                                       (item (cons priority next)))
                                  (setf (gethash key cost-so-far) (fourth next)
                                        (gethash key come-from) curr
                                        frontier (cons item frontier)
                                        frontier (sort frontier #'< :key #'first)))))))))))

(defun day22-2 ()
  (let* ((in (open "./day22.input"))
         (lst (read-by-line in))
         (result (solve-day22-2 (parse-cave-depth (first lst))
                                (parse-cave-target (second lst)))))
    (close in)
    result))