# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1544234315 18000
# Node ID e24866ca76d61d8bd251581f45955a8bc7f4f4bb
# Parent  5d5e9c5bbb978abe2e9bbc7056355dc0e8df38ff
Day 7

diff -r 5d5e9c5bbb97 -r e24866ca76d6 src/2018/main.lisp
--- a/src/2018/main.lisp	Thu Dec 06 21:23:40 2018 -0500
+++ b/src/2018/main.lisp	Fri Dec 07 20:58:35 2018 -0500
@@ -178,3 +178,57 @@
           (for point = (complex x y))
           (for total-distance = (summation coordinates :key (curry #'manhattan-distance point)))
           (counting (< total-distance 10000)))))))
+
+
+(define-problem (2018 7) (data read-lines-from-file)
+  (labels ((parse-line (line)
+             (ppcre:register-groups-bind
+                 (((rcurry #'aref 0) requirement target))
+                 (#?/Step (\w) must be finished before step (\w) can begin./ line)
+               (list target requirement)))
+           (make-graph (edges)
+             (let* ((vertices (remove-duplicates (flatten-once edges)))
+                    (graph (digraph:make-digraph :initial-vertices vertices)))
+               (dolist (edge edges)
+                 (digraph:insert-edge graph (first edge) (second edge)))
+               graph))
+           (char-number (char)
+             (1+ (- (char-code char) (char-code #\A))))
+           (task-length (task)
+             (+ 60 (char-number task)))
+           (decrement-workers (workers)
+             (gathering
+               (do-array (worker workers)
+                 (when worker
+                   (when (zerop (decf (cdr worker)))
+                     (gather (car worker))
+                     (setf worker nil)))))))
+    (values
+      (let ((graph (make-graph (mapcar #'parse-line data))))
+        ;; (digraph.dot:draw graph)
+        (recursively ((result nil))
+          (if (digraph:emptyp graph)
+            (coerce (nreverse result) 'string)
+            (let ((next (extremum (digraph:leafs graph) 'char<)))
+              (digraph:remove-vertex graph next)
+              (recur (cons next result))))))
+      (iterate
+        (with graph = (make-graph (mapcar #'parse-line data)))
+        ;; workers is a vector of (task . remaining-time) conses,
+        ;; or NILs for idle workers
+        (with workers = (make-array 5 :initial-element nil))
+        ;; (pr elapsed workers)
+        (for elapsed :from 0)
+        (for finished-tasks = (decrement-workers workers))
+        (map nil (curry #'digraph:remove-vertex graph) finished-tasks)
+        (for current-tasks = (remove nil (map 'list #'car workers)))
+        (for available-tasks = (-<> graph
+                                 digraph:leafs
+                                 (set-difference <> current-tasks)
+                                 (sort <> 'char<)))
+        (do-array (worker workers)
+          (when (null worker)
+            (when-let ((task (pop available-tasks)))
+              (setf worker (cons task (task-length task))))))
+        (when (and (digraph:emptyp graph) (every #'null workers))
+          (return elapsed))))))
diff -r 5d5e9c5bbb97 -r e24866ca76d6 vendor/make-quickutils.lisp
--- a/vendor/make-quickutils.lisp	Thu Dec 06 21:23:40 2018 -0500
+++ b/vendor/make-quickutils.lisp	Fri Dec 07 20:58:35 2018 -0500
@@ -9,6 +9,7 @@
                :curry
                :ensure-gethash
                :extremum
+               :flatten-once
                :hash-table-keys
                :hash-table-values
                :rcurry
diff -r 5d5e9c5bbb97 -r e24866ca76d6 vendor/quickutils.lisp
--- a/vendor/quickutils.lisp	Thu Dec 06 21:23:40 2018 -0500
+++ b/vendor/quickutils.lisp	Fri Dec 07 20:58:35 2018 -0500
@@ -2,7 +2,7 @@
 ;;;; See http://quickutil.org for details.
 
 ;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :COPY-HASH-TABLE :CURRY :ENSURE-GETHASH :EXTREMUM :HASH-TABLE-KEYS :HASH-TABLE-VALUES :RCURRY :READ-FILE-INTO-STRING :SYMB) :ensure-package T :package "ADVENT.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :COPY-HASH-TABLE :CURRY :ENSURE-GETHASH :EXTREMUM :FLATTEN-ONCE :HASH-TABLE-KEYS :HASH-TABLE-VALUES :RCURRY :READ-FILE-INTO-STRING :SYMB) :ensure-package T :package "ADVENT.QUICKUTILS")
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (unless (find-package "ADVENT.QUICKUTILS")
@@ -13,7 +13,7 @@
 (in-package "ADVENT.QUICKUTILS")
 
 (when (boundp '*utilities*)
-  (setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION :COMPOSE :COPY-HASH-TABLE :CURRY :ENSURE-GETHASH :EXTREMUM :MAPHASH-KEYS :HASH-TABLE-KEYS :MAPHASH-VALUES :HASH-TABLE-VALUES :RCURRY :ONCE-ONLY :WITH-OPEN-FILE* :WITH-INPUT-FROM-FILE :READ-FILE-INTO-STRING :MKSTR :SYMB))))
+  (setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION :COMPOSE :COPY-HASH-TABLE :CURRY :ENSURE-GETHASH :EXTREMUM :FLATTEN-ONCE :MAPHASH-KEYS :HASH-TABLE-KEYS :MAPHASH-VALUES :HASH-TABLE-VALUES :RCURRY :ONCE-ONLY :WITH-OPEN-FILE* :WITH-INPUT-FROM-FILE :READ-FILE-INTO-STRING :MKSTR :SYMB))))
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defun make-gensym-list (length &optional (x "G"))
     "Returns a list of `length` gensyms, each generated as if with a call to `make-gensym`,
@@ -164,6 +164,15 @@
                     :end end)))))
   
 
+  (defun flatten-once (list)
+    "Flatten `list` once."
+    (loop :for x :in list
+          :if (listp x)
+            :append x 
+          :else
+            :collect x))
+  
+
   (declaim (inline maphash-keys))
   (defun maphash-keys (function table)
     "Like `maphash`, but calls `function` with each key in the hash table `table`."
@@ -318,6 +327,6 @@
     (values (intern (apply #'mkstr args))))
   
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (export '(compose copy-hash-table curry ensure-gethash extremum hash-table-keys hash-table-values rcurry read-file-into-string symb)))
+  (export '(compose copy-hash-table curry ensure-gethash extremum flatten-once hash-table-keys hash-table-values rcurry read-file-into-string symb)))
 
 ;;;; END OF quickutils.lisp ;;;;