(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))
        (htgraph (make-hash-table :test #'eq :size 16)))
    (loop for (from flow) in (cons '(aa 0) interesting)
          do
             (setf (gethash from htgraph)
                   (cons flow
                         (loop for (to) in interesting
                               when (not (eq from to))
                                 collect (cons to (1- (length (shortest-path graph from to))))))))
    htgraph))

(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 (cdr (gethash current graph)))))

(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 = (gethash from graph) then node-to
        and node-to   = (gethash to graph)
        while node-to
        for neighbors = (cdr node-from)
        for flow = (car 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 (car (gethash name graph)))
                              (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)))