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