(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)
          for label from 0
          collect (apply #'list (ash 1 label) from flow
                         (loop for (to) in interesting
                               for target-label from 1
                               when (not (eq from to))
                                 collect (cons (ash 1 target-label) (1- (length (shortest-path graph from to)))))))))

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

(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 = (rassoc from graph :key #'car) then node-to
        and node-to   = (rassoc to graph :key #'car)
        while node-to
        for neighbors = (cdddr node-from)
        for flow = (caddr node-to)
        for distance = (cdr (assoc (car node-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))))

(defun path-to-symbols (path graph)
  (loop for node in path
        collect (cadr (assoc node graph :test #'=))))


(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 max-possible-flow (graph actors open)
  (let ((actors-min-time-left (reduce #'max actors :key #'cadr)))
    (+ (accumulated-flow actors)
       (loop for (node name flow) in graph
             :when (not (logtest node open))
             :sum (* flow actors-min-time-left)))))

(let* ((graph (worthwhile-graph (data "eg-in")))
       (path '(1 64 8 32 2 16 4))
       (sym-path (path-to-symbols path graph)))
  (list
   (path-release sym-path graph 30)
   (travel-time path graph)
   (max-possible-flow graph (list (list path 26 0)) 111))
  )

(defun traverse (graph actors open best-flow)
  (destructuring-bind (current-actor . others) actors
    (destructuring-bind (path time-left previous-flow) current-actor
      (if (or (loop for ac in actors :always (zerop (cadr ac)))
              (< (max-possible-flow graph actors open) (accumulated-flow best-flow)))
          (mapcar (lambda (a) (cons (reverse (car a)) (cdr a))) actors)
          (let* ((current-options (assoc (car path) graph :test #'=))
                 (travel-times (cdddr current-options))
                 (next
                   (loop for (node . time-there) in travel-times
                         :when (and (not (logtest node open))
                                    (let ((time-left (- time-left time-there 1)))
                                      (when (plusp time-left)
                                        (let* ((flow-there (caddr (assoc node graph :test #'=)))
                                               (next-flow (+ previous-flow (* flow-there time-left))))

                                          (cons node (list (list (cons node path) time-left next-flow)))))))
                           :collect it)))
            (if (null next)
                (traverse graph
                          (append others
                                  (list (list path 0 previous-flow)))
                          open best-flow)
                (reduce
                 (lambda (acc term)
                   (let* ((acc-flow (accumulated-flow acc))
                          (next-actors
                            (destructuring-bind (node . actors-next-move) term
                              (traverse graph
                                        (append (cdr actors) actors-next-move)
                                        (logior node open)
                                        acc))))
                     (if (> acc-flow (accumulated-flow next-actors))
                         acc next-actors)))
                 next
                 :initial-value best-flow)))))))

(defun solver (filename start-time actors)
  (let* ((action-graph (worthwhile-graph (data filename)))
         (actor (loop repeat actors collect `((1) ,start-time 0))))
    (traverse action-graph actor 1 nil)))

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

;; (require :sb-sprof)

;; (sb-sprof:with-profiling (:max-samples 1000
;;                           :report :flat
;;                           :loop t
;;                           :show-progress t)
;;    (solver "input" 19 2))

;; (time (solver "input" 19 2))
;; (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)))