|
(def tasks [:clean-breakfast :shoes :socks :cook-breakfast :eat-breakfast]) |
|
|
|
(def dependencies [[:socks :shoes] ;; socks come before shoes; shoes depend on socks |
|
[:cook-breakfast :eat-breakfast] ;; cooking comes before eating |
|
[:eat-breakfast :clean-breakfast]]) |
|
|
|
(defn grouping |
|
"Group elements of coll into a map. The key for grouping is |
|
found by calling keyfn on the element. The value is found |
|
by calling valfn on the element. Elements are added to a |
|
set in the map. |
|
|
|
Example: (grouping first second [[:a 1] [:b 2] [:a 3] [:c 2]]) |
|
|
|
=> {:a #{1 3} :b #{2} :c #{2}} |
|
" |
|
[keyfn valfn coll] |
|
(reduce (fn [acc val] |
|
(let [k (keyfn val) |
|
v (valfn val)] |
|
(update acc k (fnil conj #{}) v))) |
|
{} coll)) |
|
|
|
(defn ungroup |
|
"Remove a nested value from a grouping. If removing the |
|
value results in an empty collection, remove the key as |
|
well. |
|
|
|
Example: (ungroup {:a #{1 3} :b #{2} :c #{2}} :a 3) |
|
;; removes this 3 ^ given key & val ^ ^ |
|
=> {:a #{1} :b #{2} :c #{2}} |
|
" |
|
[map k v] |
|
(let [vs (get map k) |
|
vs' (disj vs v)] |
|
(if (empty? vs') |
|
(dissoc map k) |
|
(assoc map k vs')))) |
|
|
|
(defn order-tasks |
|
"Order tasks according to a list of dependencies. Only |
|
returns one possible order. If no order is possible, it |
|
returns the keyword :no-order. This could happen if |
|
dependencies are unmet (don't appear in the tasks |
|
collection) or there is a cycle in the dependencies. |
|
|
|
dependencies must be a list of pairs. The pair indicates |
|
that the first element must precede the second." |
|
[tasks dependencies] |
|
(let [rdeps (grouping first second dependencies)] |
|
(loop [deps (grouping second first dependencies) |
|
remaining (set tasks) |
|
order []] |
|
(let [possible (filter #(empty? (get deps %)) remaining) |
|
f (first possible)] |
|
(cond |
|
(empty? remaining) |
|
order |
|
|
|
(empty? possible) |
|
:no-order |
|
|
|
:else |
|
(recur (reduce #(ungroup %1 %2 f) deps (get rdeps f)) |
|
(disj remaining f) |
|
(conj order f))))))) |
|
|
|
(defn order-tasks-recursive |
|
"Order tasks according to a list of dependencies. Only |
|
returns one possible order. If no order is possible, it |
|
returns the keyword :no-order. This could happen if |
|
dependencies are unmet (don't appear in the tasks |
|
collection) or there is a cycle in the dependencies. |
|
|
|
dependencies must be a list of pairs. The pair indicates |
|
that the first element must precede the second." |
|
([tasks dependencies] |
|
(order-tasks-recursive (grouping first second dependencies) |
|
(grouping second first dependencies) |
|
(set tasks))) |
|
([rdeps deps remaining] |
|
(let [possible (filter #(empty? (get deps %)) remaining) |
|
f (first possible)] |
|
(cond |
|
(empty? remaining) |
|
() |
|
|
|
(empty? possible) |
|
:no-order |
|
|
|
:else |
|
(let [next (order-tasks-recursive |
|
rdeps |
|
(reduce #(ungroup %1 %2 f) deps (get rdeps f)) |
|
(disj remaining f))] |
|
(if (coll? next) |
|
(cons f next) |
|
next)))))) |