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


(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 traverse (graph actor open)
  (if (loop for ac in actor
            :always (zerop (cadr ac)))
      (mapcar (lambda (a) (cons (reverse (car a)) (cdr a))) actor)
      (advance graph actor open)))

;; (let ((graph (worthwhile-graph (data "eg-in"))))

;;   )

(defun advance (graph actor open)
  (destructuring-bind (path time-left previous-flow) (car actor)
    (let* ((current-options (assoc (car path) graph :test #'=))
           (travel-times (cdddr current-options))
           (flow-released (caddr current-options))
           (current-flow (+ previous-flow (* flow-released time-left)))
           (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)
                                  (cons node (list (list (cons node path) time-left current-flow))))))
                     :collect it)))
      (if (null next)
          (traverse graph
                    (append (cdr actor)
                            (list (list path 0 current-flow)))
                    open)

          (reduce (lambda (acc term)
                    (if (>= (accumulated-flow acc) (accumulated-flow term))
                        acc term))
           (loop for (node . actor-next-move) in next
                 collect
                 (traverse graph
                           (append (cdr actor) actor-next-move)
                           (logior node open))))))))

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

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