(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 next-options (current-options open time-left)
  (flet ((appropriate (next)
           (destructuring-bind (next-node-name . time-there) next
             (and (zerop (logand next-node-name open))
                  (< (1+ time-there) time-left)))))
    (remove-if-not #'appropriate (cdddr 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 = (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 solver (filename start-time actors)
  (let* ((action-graph (worthwhile-graph (data filename)))
         (actor (loop repeat actors collect `((1) ,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 (assoc (car path) graph :test #'=))
                            (flow-released (caddr 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)))
                                            (logior name open)))))

                            (mapcar next)
                            (sort #'>= :key #'accumulated-flow)
                            (car))))))))
      ;; (princ)
      (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)))))

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

;; (sb-sprof:with-profiling (:max-samples 1000
;;                           :report :flat
;;                           :loop t
;;                           :show-progress t)
;;   (dotimes (_ 100)
;;     (solver "eg-in" 30 1)))

;; (time (solver "eg-in" 30 1))
;; (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)))