(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))))
;;
;; 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 (gethash 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 (filename)
  (let* ((action-graph (worthwhile-graph (data filename)))
         (start-time 26)
         (actor (list `((aa) ,start-time 0) `((aa) ,start-time 0))))

    ;; (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) (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 (lambda (actor-paths)
                                              ;; (path-release2 actor-paths graph start-time)
                                              (reduce #'+ actor-paths :key #'caddr)
                                              ))
                            (car))))))))
      ;; (princ)
      (traverse action-graph actor '(aa)))))

(fiveam:test solution2
  (fiveam:is
   (= 1707 (reduce #'+ (solver "eg-in" 26 2) :key #'caddr)))
  (fiveam:is
   (= 2474 (reduce #'+ (part2 "input") :key #'caddr)))
  )

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