(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-options 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 current-options))))

(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)
(fiveam:test loads
  (fiveam:is
   (= 1648 (path-release '(AA DD JJ BB CC HH EE) (worthwhile-graph (data "eg-in")) 30)))
  (fiveam:is
   (= 1651 (path-release '(AA DD BB JJ HH EE CC) (worthwhile-graph (data "eg-in")) 30)))
  (fiveam:is
   (= 560 (path-release '(AA DD) (worthwhile-graph (data "eg-in")) 30))))

(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 accumulated-flow (actor-paths)
  (reduce #'+ actor-paths :key #'caddr))

(defun solver (filename start-time actors)
  (let* ((action-graph (worthwhile-graph (data filename)))
         (actor (loop repeat actors collect `((aa) ,start-time 0))))
    (labels ((traverse (graph actor open)
               (if (loop for ac in actor
                         :always (zerop (cadr ac)))
                   (mapcar (lambda (a) (cons (reverse (car a)) (cdr a))) actor)
                   (destructuring-bind (path time-left previous-flow) (car actor)
                     ;; (princ (car actor))
                     ;; (princ (path-release2 (reverse open) graph start-time))
                     ;; (princ (recover-paths (reverse open)))
                     ;; (terpri)
                     (let* ((current-options (gethash (car path) graph))
                            (flow-released (car current-options))
                            (current-flow (+ previous-flow (* flow-released time-left)))
                            (next (next-options current-options open time-left)))
                       (if (null next)
                           (traverse graph
                                     (append (cdr actor)
                                             (list (list path 0 current-flow)))
                                     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
                                                                            current-flow)))
                                            (cons name open)))))

                            (mapcar next)
                            (sort #'>= :key #'accumulated-flow)
                            (car))))))))
      ;; (princ)
      (traverse action-graph actor '(aa)))))

(fiveam:test solutions
  (fiveam:is
   (= 1651 (accumulated-flow (solver "eg-in" 30 1))))
  (fiveam:is
   (= 1754 (accumulated-flow (solver "input" 30 1))))
  (fiveam:is
   (= 1707 (accumulated-flow (solver "eg-in" 26 2))))
  (fiveam:is
   (= 2474 (accumulated-flow (solver "input" 26 2)))))

(fiveam:run-all-tests)
;; (require :sb-sprof)

;; (sb-sprof:with-profiling (:max-samples 1000
;;                           :report :flat
;;                           :loop t
;;                           :show-progress t)
;;   (dotimes (_ 100)
;;     (part2 "eg-in"))
;;   )
;; (time (part2 "eg-in"))
;; (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)))