(ql:quickload '(fiveam cl-ppcre uiop arrows))

(defun data (filename)
  (with-open-file (in filename)
    (loop for line = (read-line in nil nil)
          while line
          collect (cl-ppcre:register-groups-bind (val (#'parse-integer flow) others)
                      ("Valve (\\w+) has flow rate=(\\d+); tunnels? leads? to valves? (.+)" line)
                    `(,(intern val) ,flow ,@(mapcar #'intern (cl-ppcre:split ", " others)))))))

(defun next-steps (current graph paths)
  (flet ((appropriate (next)
           (and (not (gethash next paths)) ;; not visited
                (setf (gethash next paths) (cons next (gethash current paths))))))
    (remove-if-not #'appropriate
                   ;; name flow connections -> cddr
                   (cddr (assoc current graph :test #'eq)))))

(defun shortest-path (graph from to)
  (let ((paths (make-hash-table :test #'eq)))
    (setf (gethash from paths) (list from))
    (labels ((traverse (queue paths)
               (unless (null queue)
                 (let ((next (next-steps (car queue) graph paths)))
                   (unless (member to next :test #'eq)
                     (traverse (append (cdr queue) next) paths))))))
      (traverse (list from) paths))
    ;; (loop for k being the hash-keys in paths using (hash-value v)
    ;;       do (format t "~a=>~a~%" k v))
    (gethash to paths)))

(defun worthwhile-graph (graph)
  (let ((interesting (remove-if #'zerop graph :key #'cadr)))
    (loop for (from flow) in (cons '(aa 0) interesting)
          collect (nconc (list from flow)
                         (loop for (to) in interesting
                               when (not (eq from to))
                                 collect (cons to (1- (length (shortest-path graph from to)))))))))

(defun travel-time (path graph)
  (loop for (from to) on path
        while to
        for neighbors = (cddr (assoc from graph :test #'eq))
        for distance = (cdr (assoc to neighbors :test #'eq))
        sum (1+ distance) into runtime
        collect runtime))

(defun next-options (current graph open time-left)
  (flet ((appropriate (next)
           (destructuring-bind (next-node-name . time-there) next
             (and (not (member next-node-name open :test #'eq))
                  (< (1+ time-there) time-left)))))
    (remove-if-not #'appropriate (cddr (assoc current graph :test #'eq)))))

(defun path-release-as (path graph start-time)
  (loop for (from to) on path
        while to
        for neighbors = (cddr (assoc from graph :test #'eq))
        for flow = (cadr (assoc to graph :test #'eq))
        for distance = (cdr (assoc to neighbors :test #'eq))
        sum (1+ distance) into runtime
        sum (* flow (- start-time runtime)) into release
        finally (return release)))

(defun path-release (path graph start-time)
  (loop for (from to) on path
        for node-from = (assoc from graph :test #'eq) then node-to
        and node-to   = (assoc to graph :test #'eq)
        while node-to
        for neighbors = (cddr node-from)
        for flow = (cadr node-to)
        for distance = (cdr (assoc to neighbors :test #'eq))
        sum (1+ distance) into runtime
        sum (* flow (- start-time runtime)) into release
        finally (return release)))

(shortest-path (data "eg-in") 'AA 'CC)

(= 1648 (path-release '(AA DD JJ BB CC HH EE) (worthwhile-graph (data "eg-in")) 30))
(= 1651 (path-release '(AA DD BB JJ HH EE CC) (worthwhile-graph (data "eg-in")) 30))
(= 560 (path-release '(AA DD) (worthwhile-graph (data "eg-in")) 30))
;;
;; part 1
(let* ((open '(aa))
       (action-graph (worthwhile-graph (data "input")))
       (start-time 30))
  ;; (path-release)

  ;; (loop for k being the hash-keys in open using (hash-value v)
  ;;       do (format t "~a=>~a~%" k v))
  (labels ((traverse (graph node open time-left current-flow)
             (let ((next (next-options node graph open time-left)))
               (if (null next)
                   (reverse open)
                   (arrows:->
                    (lambda (next-node)
                      (destructuring-bind (name . time-there) next-node
                        (let ((flow (cadr (assoc name graph :test #'eq)))
                              (time-left (- time-left time-there 1)))
                          (traverse graph name (cons name open)
                                    time-left
                                    (+ current-flow
                                       (* flow time-left))))))
                    (mapcar next)
                    (sort #'>= :key (lambda (path) (path-release path graph start-time)))
                    (car))))))
    (traverse action-graph 'aa open start-time 0)))

;; part 2

(defun path-release2 (paths graph start-time)
  (reduce #'+ paths
          :key (lambda (path) (path-release path graph start-time))))


(path-release '(AA DD) (worthwhile-graph (data "eg-in")) 26)
(path-release '(AA DD EE) (worthwhile-graph (data "eg-in")) 26)
(path-release '(AA DD HH EE) (worthwhile-graph (data "eg-in")) 12)
(path-release '(AA DD EE HH) (worthwhile-graph (data "eg-in")) 12)

(path-release2 '((AA NU WK NC ZG EA CX QC) (AA RA XK YH NM YP XS)) (worthwhile-graph (data "input")) 26)
(path-release2 '((AA NU WK NC ZG EA CX QC) (AA XK YH NM YP XS)) (worthwhile-graph (data "input")) 26)
;; (travel-time
;;  ;; '(AA NU WK NC ZG XK YH NM YP)
;;  ;; '(AA NU WK NC ZG EA CX QC)
;;     '(AA RA XK YH NM YP XS)
;;  (worthwhile-graph (data "input")))

(defun part2 ()
  (let* ((action-graph (worthwhile-graph (data "eg-in")))
         (start-time 26)
         (actor (list `((aa) ,start-time) `((aa) ,start-time))))

    ;; (loop for k being the hash-keys in open using (hash-value v)
    ;;       do (format t "~a=>~a~%" k v))
    (labels ((traverse (graph actor open)
               (if (loop for ac in actor
                         :always (zerop (cadr ac)))
                   (mapcar (lambda (a) (reverse (car a))) actor)
                   (destructuring-bind (path time-left) (car actor)
                     ;; (princ (car actor))
                     ;; (princ (path-release2 (reverse open) graph start-time))
                     ;; (princ (recover-paths (reverse open)))
                     ;; (terpri)
                     (let ((next (next-options (car path) graph open time-left)))
                       (if (null next)
                           (traverse graph
                                     (append (cdr actor)
                                             (list (list path 0)))
                                     open)

                           (arrows:->
                            (lambda (next-node)
                              (destructuring-bind (name . time-there) next-node
                                (let ((time-left (- time-left time-there 1)))
                                  (traverse graph
                                            (append (cdr actor) (list (list (cons name path) time-left)))
                                            (cons name open)))))

                            (mapcar next)
                            (sort #'>= :key (lambda (actor-paths)
                                              (path-release2 actor-paths graph start-time)))
                            (car))))))))
      ;; (princ)
      (traverse action-graph actor '(aa)))))

(require :sb-sprof)

(sb-sprof:with-profiling (:max-samples 1000
                          :report :flat
                          :loop t
                          :show-progress t)
  (dotimes (_ 100)
    (part2))
  )
(time (part2))
;; (length (worthwhile-graph (data "input")))

;; (loop for (name flow . neighbors) in (worthwhile-graph (data "input"))
;;       do (loop for (nn . dist) in neighbors
;;                do (format t "~a -> ~a [label=\"~d\"]~%" name nn dist)))