diff --git a/CHANGELOG.md b/CHANGELOG.md index 0b95158..6b74e72 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,17 +1,26 @@ CHANGELOG ========== +## 0.2.0 +* Add ClojureScript support thanks to the use of reader conditionals, + the same namespaces are used. +* Removed dependencies to loom and combinatorics. Use own [Tarjan's + algorithm](https://en.wikipedia.org/wiki/Tarjan%27s_strongly_connected_components_algorithm) implementation. +* Removed reliance on core.async, now using a purely functional + implementation using loop/recur (So ClojureScript Support is + possible). +* Added new error type : `:unable-to-schedule` + ## 0.1.4 -* Now the main channel is buffered. No need to wait for a place to put +* The main channel is buffered. No need to wait for a place to put on the work of a resource, there is enough room for all of them. -* Eliminated a "silly" ( "Any sufficiently advanced technology is indistinguishable from magic" - According to Clarke's 3rd Law -Milestones is a Clojure library that needs only your project tasks description in order to generate the best possible schedule for you. This is based on priorities of scheduling that you set (in terms of fields in tasks, more about this in a second). +Milestones is a Clojure and ClojureScript library that needs only your project tasks description in order to generate the best possible schedule for you. This is based on priorities of scheduling that you set (in terms of fields in tasks, more about this in a second). Constraints on tasks are: - Resources (i.e, which resource is needed to perform a particular task), @@ -217,11 +217,14 @@ should not happen). Error Map Key | What it means -------------------------------|----------------------------- -:reordering-errors | { 1 [:priority],...} You gave priority to tasks according to fields (:priority) which some tasks (1) lack) +:unable-to-schedule | Something made it impossible for the +recursive algorithm to terminate... +:reordering-errors | { 1 [:priority],...} You gave priority to tasks according to fields (:priority) which some tasks (1) lack). :tasks-w-predecessors-errors | :{6 [13],...} These tasks have these non-existent predecessors. -:tasks-w-no-resources | [1,... These tasks are not milestones and are not assigned to any resource -:tasks-cycles | [[1 2] [3 5]... Couple of tasks that are in a cycle : 1 depends on 2, and 2 on 1 -:milestones-w-no-predecessors | [1 2... These milestones don't have predecessors +:tasks-w-no-resources | [1,... These tasks are not milestones and are not assigned to any resource. +:tasks-cycles | [[1 2 3]... Set of tasks that are in. +a cycle. In this example, 2 depends on 1, 2 on 3 and 3 on 1. +:milestones-w-no-predecessors | [1 2... These milestones don't have predecessors. ## History @@ -234,6 +237,10 @@ Cup 2014. You can find the code and some technical explanation of the algorithms in use (core.async, etc...) [here.](https://github.com/turbopape/milestones-clojurecup2014) +as of version 0.2.X and above, milestone uses a purely functional +algorithm using the same logic of assigning work units, but simply +relying on recur to advance the system status. + Although the prototype showcases the main idea, this repository is the official one, i.e, contains latest versions and is more thoroughly tested. ## Code Of Conduct diff --git a/project.clj b/project.clj index 989d146..9b366d4 100644 --- a/project.clj +++ b/project.clj @@ -1,14 +1,28 @@ -(defproject automagic-tools-milestones "0.1.4" +(defproject automagic-tools-milestones "0.2.0" :description "Milestones : the Automagic Project Tasks Scheduler" :url "http://turbopape.github.io/milestones" :license {:name "MIT" :url "http://opensource.or g/licenses/MIT"} + :dependencies [[org.clojure/clojure "1.8.0"] - [org.clojure/core.async "0.2.374"] - [org.clojure/math.combinatorics "0.1.1"] - [aysylu/loom "0.5.4"] - [expectations "2.0.9"]] + [org.clojure/clojurescript "1.9.229"] + [expectations "2.1.8"]] + + :clean-targets ^{:protect false} ["target"] + + :plugins [[lein-cljsbuild "1.1.4"]] + + :cljsbuild { + :builds [{:id "milestones" + :source-paths ["src"] + + :compiler {:output-to "target/out/milestones.js" + :output-dir "target/out" + :optimizations :none + :source-map true}}]} + :scm {:name "git" :url "https://github.com/turbopape/milestones.git"} + :profiles {:uberjar {:aot :all} :dev {:plugins [[lein-expectations "0.0.8"]]}}) diff --git a/src/milestones/dyna_scheduler.clj b/src/milestones/dyna_scheduler.cljc similarity index 63% rename from src/milestones/dyna_scheduler.clj rename to src/milestones/dyna_scheduler.cljc index 2064297..e4f9d39 100755 --- a/src/milestones/dyna_scheduler.clj +++ b/src/milestones/dyna_scheduler.cljc @@ -1,54 +1,11 @@ ;; -;; Copyright (C) 2014 , Rafik NACCACHE - -;; This program is free software: you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation, either version 3 of -;; the License, or (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public -;; License along with this program. If not, see -;; . - -;;; Using core.async channels, it will plan tasks. -;;; input is a map of tasks like: - - -;;; 1 {:task-name "A description about this task" -;;; ;the resource that'll be booked doing the task -;;; :resource-id 3 -;;; ;the duration that this resource will be booked during this task -;;; :duration 3 -;;; ;priority : less is higher priority -;;; :priority 1 -;;; ;predecessors : if they are not complete, task cannot be fired. -;;; predecessors [2 4]} - - -;;; work queue are the tasks to be processed, i.e [ 2 3 1... -;;; work flow are the task units to be fed to the channel , i.e [ 1 1 1 3 3 3... -;;; work in progress are the task that have already been processed by the resource -;;; complete task is a task already totally in the output schedule. -;;; an output schedule is like this : -;;; [{:task-id 1 :time 1 :resource-id 1} -;;; {:task-id 1 :time 2 :resource-id 1} -;;; {:task-id 3 :time 1 :resource-id 1} -;;; {:task-id 3 :time 2 :resource-id 1} -;;; {:task-id 3 :time 3 :resource-id 1}] - -;;; a function exist in the end that emits same tasks with begin field, or errors to be treated. +;; Copyright (C) 2016 , Rafik NACCACHE (ns milestones.dyna-scheduler (:require - [milestones.graph-utilities :refer :all] - [clojure.set] - [clojure.core.async :as async - :refer [chan go alts! alts!! >! >!! v (assoc :begin (apply min the-tv)) (assoc :achieved (count the-tv)))] a-task))) - (defn format-tasks-in-output-schedule "Given an output schedule : [{:task-id 1 :time 1 :resource-id 1} @@ -207,7 +172,7 @@ tasks))) (defn work-flow-for-resource - "given a user, its current work-queue, tasks and current output schedule, + "given a user, its current work-queue, tasks and current output schedule, we find his tasks, the fireable ones, reorder all of them (if preemptive) or those non work in propress if not, and issue new work-flow" [current-work-flow @@ -221,12 +186,12 @@ fireable-tasks-ids) his-fireable-tasks (tasks-for-resource fireable-tasks resource-id) - his-incomplete-fireable-tasks (into {} - (filter #(not (task-complete? - tasks - current-output-schedule - (key %))) - his-fireable-tasks)) + his-incomplete-fireable-tasks (into {} + (filter #(not (task-complete? + tasks + current-output-schedule + (key %))) + his-fireable-tasks)) his-incomplete-fireable-tasks-ids (keys his-incomplete-fireable-tasks) ;; id of the task to be kept, work in progress fireable-id-in-wp (first (filter (partial task-in-work-in-progress? @@ -234,12 +199,12 @@ current-work-flow) his-incomplete-fireable-tasks-ids)) wp-vector (vec (repeat (work-in-progress-count current-work-flow - fireable-id-in-wp) - fireable-id-in-wp)) + fireable-id-in-wp) + fireable-id-in-wp)) ;; [ the part to be reordered and generated] fireable-ids-not-in-wp (vec - (remove #(= % fireable-id-in-wp) - his-incomplete-fireable-tasks-ids )) + (remove #(= % fireable-id-in-wp) + his-incomplete-fireable-tasks-ids )) his-fireable-tasks-not-in-wp (select-keys tasks fireable-ids-not-in-wp) his-ordered-tasks-not-in-wp (reorder-tasks his-fireable-tasks-not-in-wp reordering-properties) @@ -248,29 +213,31 @@ ;; will be used to sync the threads, on for each resource (into his-new-ordered-workflow wp-vector))) -(defn run-scheduler-for-resource! - "This runs a thread for the resource-id, connects to a channel, - and waits to process a task-unit / timer tick, until the channel is closed" +(defn run-scheduler-for-resource + "For this timer, computes aht task unit this resource will compute, + yielding a new workflows map" [timer resource-id tasks output-schedule workflows - reordering-properties - chan-to-output] - (let [current-flow-for-resource (@workflows resource-id) - my-workflow (work-flow-for-resource current-flow-for-resource - tasks - resource-id - output-schedule - reordering-properties) - the-task-unit {:task-id (peek my-workflow) - :time timer - :resource-id resource-id} - _ (if (seq my-workflow) - (alter workflows assoc resource-id (pop my-workflow)))] - ;; now we inject the task-unit in the channel - (go (>! chan-to-output the-task-unit)))) + reordering-properties] + + (let [current-flow-for-resource (get workflows resource-id) + my-workflow (work-flow-for-resource current-flow-for-resource + tasks + resource-id + output-schedule + reordering-properties) + the-task-unit {:task-id (peek my-workflow) + :time timer + :resource-id resource-id}] + + {:task-unit the-task-unit + :new-workflows (if (seq my-workflow) + (assoc workflows + resource-id + (pop my-workflow)))})) (defn total-task-duration "Computes total tasks duration as if they were done sequentially." @@ -281,78 +248,105 @@ (filter (comp not nil?)) (reduce +))) + +(defn move-system-status-gen + [tasks + reordering-properties + timer + resources-ids + output-schedule + workflows] + + ;=> {:task-unit t :workflow wf} + (if (seq resources-ids) + (let [resource (first resources-ids) + new-system-status (run-scheduler-for-resource timer + resource + tasks + output-schedule + workflows + reordering-properties)] + (recur + tasks + reordering-properties + timer + (rest resources-ids) + (let [new-task-unit (get new-system-status :task-unit)] + (if (get new-task-unit :task-id) + (conj output-schedule new-task-unit) + output-schedule)) + (get new-system-status :new-workflows))) + {:new-output-schedule output-schedule + :new-workflows workflows})) + (defn run-scheduler "this is the master-mind. runs all of them, collects their inputs, and then goes home" [tasks reordering-properties] - (let [timer (ref 0) - max-time (* 2 (total-task-duration tasks)) - workflows (ref {}) - output-schedule (ref []) + (let [max-time (* 2 (total-task-duration tasks)) resources-ids (set (map :resource-id (vals tasks))) - c-to-me (chan (count resources-ids))] - (dosync - (while - (and (< @timer max-time) - (not (every? (partial task-complete? - tasks - @output-schedule) (keys tasks)))) - (alter timer inc) - (doseq [resource resources-ids] - ;; next tick - ;; I fire their schedules - (run-scheduler-for-resource! @timer - resource - tasks - @output-schedule - workflows - reordering-properties - c-to-me)) - (dotimes [_ (count resources-ids)] - (alter output-schedule conj ( curated-tasks - (run-scheduler reordering-properties) - (format-tasks-in-output-schedule curated-tasks)))} + (let [curated-tasks (prepare-tasks tasks)] + (if-let [result (run-scheduler curated-tasks + reordering-properties)] + {:errors nil + :result (format-tasks-in-output-schedule result curated-tasks)} + + {:result nil + :errors :unable-to-schedule})) {:result nil :errors (into {} (filter (comp not nil? val) errors))}))) diff --git a/src/milestones/graph_utilities.clj b/src/milestones/graph_utilities.clj deleted file mode 100644 index a633868..0000000 --- a/src/milestones/graph_utilities.clj +++ /dev/null @@ -1,59 +0,0 @@ -;; -;; Copyright (C) 2014 , Rafik NACCACHE - -;; This program is free software: you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation, either version 3 of -;; the License, or (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public -;; License along with this program. If not, see -;; . - - -(ns milestones.graph-utilities - (:require - [loom.graph :refer [digraph nodes]] - [loom.alg :refer [bf-path]] - [clojure.math.combinatorics :refer [combinations]])) - -(defn predecessors-of-task-exist? - "return true if all predecessors of this task - exist or if this task has no preds" - [tasks the-task] - (every? - (partial contains? (set (keys tasks))) - (:predecessors the-task))) - -(defn task-has-predecessors? - "return true if this task has preds" - [the-task] - (seq (:predecessors the-task))) - -(defn gen-precendence-edge - "a utility function, given 1 + [ 2 3] returns [1 2], [1 3]" - [task-id predecessors] - (mapv (fn[predecessor] [task-id predecessor]) predecessors)) - -(defn gen-all-precedence-edges - "Given tasks, computes all the edges present in this graph" - [tasks] - (let [raw-maps (map (fn [[k v]] [k (:predecessors v)]) - tasks)] - (mapcat (fn [[k v]] (gen-precendence-edge k v) ) raw-maps))) - -(defn graph-cycles - "tests for every couple a and b if there is a path - btw a -> b and b-> : this is a cycle. edges is a digraph (loom)" - [edges] - (let [di-graph (apply digraph edges) - vertices (vec(nodes di-graph) ) - all-paths (combinations vertices 2)] - (mapv vec (filter (fn [[l r]] (and (seq (bf-path di-graph l r)) - (seq (bf-path di-graph r l))) ) - all-paths)))) diff --git a/src/milestones/graph_utilities.cljc b/src/milestones/graph_utilities.cljc new file mode 100644 index 0000000..7f96aec --- /dev/null +++ b/src/milestones/graph_utilities.cljc @@ -0,0 +1,80 @@ +;; +;; Copyright (C) 2016 , Rafik NACCACHE + +(ns milestones.graph-utilities) + +(defn predecessors-of-task-exist? + "return true if all predecessors of this task + exist or if this task has no preds" + [tasks the-task] + (every? + (partial contains? (set (keys tasks))) + (:predecessors the-task))) + +(defn task-has-predecessors? + "return true if this task has preds" + [the-task] + (seq (:predecessors the-task))) + +(defn gen-precendence-edge + "a utility function, given 1 + [ 2 3] returns [1 2], [1 3]" + [task-id predecessors] + (mapv (fn[predecessor] [task-id predecessor]) predecessors)) + +(defn gen-all-precedence-edges + "Given tasks, computes all the edges present in this graph" + [tasks] + (let [raw-maps (map (fn [[k v]] [k (:predecessors v)]) + tasks)] + (mapcat (fn [[k v]] (gen-precendence-edge k v) ) raw-maps))) + +(defn vertices + [edges] + (->> edges + (mapcat identity ) + set)) + +(defn successors + [vertex edges] + (->> edges + (filter (comp (partial = vertex) first)) + (map second))) + +(defn graph-cycles + "Uses [Tarjan]((https://en.wikipedia.org/wiki/Tarjan%27s_strongly_connected_components_algorithm)'s + strongly connectect components algorithm to find if there are any + cycles in a graph" + [edges] + (let [index (atom 0) + indices (atom {}) ;;{vertex index, ...} + lowlinks (atom {}) + S (atom (list));;{vertex lowlink} + output (atom [])] + (letfn [(strong-connect [v] + (swap! indices assoc-in [v] @index) + (swap! lowlinks assoc-in [v] @index) + (swap! index inc) + (swap! S conj v) + (let [succs (successors v edges)] + (doseq [w succs] + (if (not (contains? @indices w)) + (do (strong-connect w) + (swap! lowlinks assoc-in [v] (min (get @lowlinks v) + (get @lowlinks w)))) + (if (some #{w} @S ) + (swap! lowlinks assoc-in [v] (min (get @lowlinks v) + (get @indices w)))))) + (if (= (get @lowlinks v) + (get @indices v)) + (loop [w (peek @S) + r []] + (swap! S pop) + (if (not (= v w)) + (recur (peek @S) + (conj r w)) + (when-not (empty? r) + (swap! output conj (conj r w))))))))] + (doseq [v (vertices edges)] + (when-not (get @indices v) + (strong-connect v))) + @output))) diff --git a/test/milestones/dyna_scheduler_test.clj b/test/milestones/dyna_scheduler_test.clj index 63a5020..efc6a3b 100644 --- a/test/milestones/dyna_scheduler_test.clj +++ b/test/milestones/dyna_scheduler_test.clj @@ -3,56 +3,146 @@ (:use expectations)) (def correct-tasks {1 {:task-name "Bring bread" - :resource-id "mehdi" - :duration 5 - :priority 1 - :predecessors []} - - 2 {:task-name "Bring butter" - :resource-id "rafik" - :duration 5 - :priority 1 - :predecessors []} - - 3 {:task-name "Put butter on bread" - :resource-id "salma" - :duration 3 - :priority 1 - :predecessors [1 2]} - - 4 {:task-name "Eat toast" - :resource-id "rafik" - :duration 4 - :priority 1 - :predecessors [3]} - - 5 {:task-name "Eat toast" - :resource-id "salma" - :duration 4 - :priority 1 - :predecessors [3]} - - ;; now some milestones - 6 {:task-name "Toasts ready" - :is-milestone true - :predecessors [3] - }}) + :resource-id "mehdi" + :duration 5 + :priority 1 + :predecessors []} + 2 {:task-name "Bring butter" + :resource-id "rafik" + :duration 5 + :priority 1 + :predecessors []} + + 3 {:task-name "Put butter on bread" + :resource-id "salma" + :duration 3 + :priority 1 + :predecessors [1 2]} + + 4 {:task-name "Eat toast" + :resource-id "rafik" + :duration 4 + :priority 1 + :predecessors [3]} + + 5 {:task-name "Eat toast" + :resource-id "salma" + :duration 4 + :priority 1 + :predecessors [3]} + + ;; now some milestones + 6 {:task-name "Toasts ready" + :is-milestone true + :predecessors [3]}}) (def correct-tasks-schedule (schedule correct-tasks [:priority])) -;; some tests, we sure can do more of them - ;; test if correct-tasks-schedule :errors is nil (expect true (nil? (:error correct-tasks-schedule))) ;; test if task 6 is scheduled after 3 (expect true (> - (-> - :begin - ((:result correct-tasks-schedule) 6)) - (-> - :begin - ((:result correct-tasks-schedule) 3)))) + (get-in correct-tasks-schedule [:result 6 :begin] ) + (get-in correct-tasks-schedule [:result 3 :begin] ))) + +;; Detecting cycles + +(def cyclic-tasks {1 {:task-name "task 1" + :resource-id "mehdi" + :duration 5 + :priority 1 + :predecessors [3]} + + 2 {:task-name "task 2" + :resource-id "rafik" + :duration 5 + :priority 1 + :predecessors [1]} + + 3 {:task-name "task 3" + :resource-id "salma" + :duration 3 + :priority 1 + :predecessors [2]}}) + +(expect [[2 3 1]] + (get-in + (schedule cyclic-tasks [:priority]) + [:errors :tasks-cycles])) + +;; task 3 has no resource but is no milestone, +;; task 1 is a milestone, so only task 3 should be reported +(def tasks-w-no-resource {3 {:task-name "task 3" + :duration 3 + :priority 1 + :predecessors []} + + 1 {:task-name "milestone 1" + :duration 3 + :priority 1 + :is-milestone true + :predecessors [3]}}) + +(expect + [3] + (get-in + (schedule tasks-w-no-resource [:priority]) + [:errors :tasks-w-no-resources])) + + +;; some tasks with inexisting predecessors +(def tasks-w-predecessors-errors {3 {:task-name "task 3" + :duration 3 + :priority 1 + :predecessors [17]} + + 1 {:task-name "task 1" + :duration 3 + :priority 1 + :predecessors []}}) + +(expect + {3 [17]} + (get-in + (schedule tasks-w-predecessors-errors [:priority]) + [:errors :tasks-w-predecessors-errors])) + +;; Some tasks that do not contain the ordering field +(def tasks-w-reordering-errors {3 {:task-name "task 3" + :duration 3 + :predecessors []} + + 1 {:task-name "task 1" + :duration 3 + :priority 1 + :predecessors [3]}}) + + +(expect + {3 [:priority]} + (get-in + (schedule tasks-w-reordering-errors [:priority]) + [:errors :reordering-errors])) + + +;; Milestones with no predecessors errors +(def milestones-w-no-predecessors {3 {:task-name "task 3" + :duration 3 + :priority 1 + :predecessors []} + + 1 {:task-name "milestone 1" + :duration 3 + :priority 1 + :is-milestone true + :predecessors []}}) + +(expect + [1] + (get-in + (schedule milestones-w-no-predecessors [:priority]) + [:errors :milestones-w-no-predecessors]))