├── logo.jpg ├── doc └── intro.md ├── .travis.yml ├── CONTRIBUTING.md ├── .gitignore ├── CONTRIBUTORS.md ├── project.clj ├── LICENSE ├── CHANGELOG.md ├── src └── milestones │ ├── graph_utilities.cljc │ └── dyna_scheduler.cljc ├── CODE_OF_CONDUCT.md ├── test └── milestones │ └── dyna_scheduler_test.clj └── README.md /logo.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/turbopape/milestones/HEAD/logo.jpg -------------------------------------------------------------------------------- /doc/intro.md: -------------------------------------------------------------------------------- 1 | # Introduction to milestones 2 | 3 | TODO: write [great documentation](http://jacobian.org/writing/what-to-write/) 4 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: clojure 2 | lein: lein2 3 | script: lein test 4 | jdk: 5 | - openjdk7 6 | - oraclejdk7 7 | - oraclejdk8 8 | 9 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | CONTRIBUTING 2 | ============ 3 | 4 | There are many ways with which you can help the development of milestones: 5 | 6 | - Add Graphical GANTT outputs, be they ASCII, or HTML ! 7 | 8 | All PRs are welcome ! 9 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | pom.xml 2 | pom.xml.asc 3 | *jar 4 | *~ 5 | *# 6 | .log 7 | /resources/public/js/compiled/out/ 8 | /lib/ 9 | /classes/ 10 | /target/ 11 | /checkouts/ 12 | .lein-deps-sum 13 | .lein-repl-history 14 | .lein-plugins/ 15 | .lein-failures 16 | -------------------------------------------------------------------------------- /CONTRIBUTORS.md: -------------------------------------------------------------------------------- 1 | CONTRIBUTORS 2 | ============= 3 | 4 | ## Proof readers 5 | 6 | - [seanlane](https://github.com/seanlane) 7 | - [salman-bhai](https://github.com/salman-bhai) 8 | - [Kietzmann](https://github.com/Kietzmann) 9 | - [Tchinmai7](https://github.com/Tchinmai7) 10 | - [JonathanSpeek](https://github.com/JonathanSpeek) 11 | - [JohnWillis0112358](https://github.com/JohnWillis0112358) 12 | - [Tocive](https://github.com/Tocive) 13 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject org.clojars.turbopape/milestones "1.0.1" 2 | :description "Milestones : the Automagic Project Planner" 3 | :url "http://turbopape.github.io/milestones" 4 | :license {:name "MIT" 5 | :url "http://opensource.or g/licenses/MIT"} 6 | 7 | :min-lein-version "2.7.1" 8 | 9 | :dependencies [[org.clojure/clojure "1.8.0"]] 10 | 11 | :scm {:name "git" 12 | :url "https://github.com/turbopape/milestones.git"}) 13 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2016 Rafik Naccache 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: 6 | 7 | The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. 8 | 9 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 10 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | CHANGELOG 2 | ========== 3 | ## 1.0.0-1 4 | * Removed public assets. 5 | * changed versions scheme to refelct api changes. 6 | 7 | ## 0.4.0 8 | * Revert back to the unique lib format. Milestones is a lib, not a web 9 | site not an NLP Parser. Will copy over the cljs etc to another 10 | project. 11 | * Removed dependency to expectations. 12 | 13 | ## 0.3.1 14 | * Provide suport for task definition in YAML 15 | 16 | ## 0.3.0 17 | * Add GANTT Charts generation Thanks to [Google Charts Lib](https://developers.google.com/chart/interactive/docs/gallery/ganttchart) 18 | * Add support for NLP syntax parsing in clojurescript - 19 | Using 20 | [nlp-compromise](https://github.com/nlp-compromise/nlp_compromise) 21 | * Created a little Web Play Ground. 22 | 23 | ## 0.2.1 24 | * Fix output if the task is a milestone, don't show the random 25 | generated user. 26 | 27 | ## 0.2.0 28 | * Add ClojureScript support thanks to the use of reader conditionals, 29 | the same namespaces are used. 30 | * Removed dependencies to loom and combinatorics. Use own [Tarjan's 31 | algorithm](https://en.wikipedia.org/wiki/Tarjan%27s_strongly_connected_components_algorithm) implementation. 32 | * Removed reliance on core.async, now using a purely functional 33 | implementation using loop/recur (So ClojureScript Support is 34 | possible). 35 | * Added new error type : `:unable-to-schedule` 36 | 37 | ## 0.1.4 38 | * The main channel is buffered. No need to wait for a place to put 39 | on the work of a resource, there is enough room for all of them. 40 | * Fix Code Style. 41 | 42 | ## 0.1.3 43 | * Now Errors for non existent tasks show a map { task-id [missing task-id]... 44 | 45 | ## 0-1.0 - 0.1.2 46 | * Version Bumps to allow clojars to update. 47 | * Add support for milestones 48 | * Add support for detailed error messages 49 | * Add support for cyclic graphs 50 | 51 | -------------------------------------------------------------------------------- /src/milestones/graph_utilities.cljc: -------------------------------------------------------------------------------- 1 | ;; 2 | ;; Copyright (C) 2016 , Rafik NACCACHE 3 | 4 | (ns milestones.graph-utilities) 5 | 6 | (defn predecessors-of-task-exist? 7 | "return true if all predecessors of this task 8 | exist or if this task has no preds" 9 | [tasks the-task] 10 | (every? 11 | (partial contains? (set (keys tasks))) 12 | (:predecessors the-task))) 13 | 14 | (defn task-has-predecessors? 15 | "return true if this task has preds" 16 | [the-task] 17 | (seq (:predecessors the-task))) 18 | 19 | (defn gen-precendence-edge 20 | "a utility function, given 1 + [ 2 3] returns [1 2], [1 3]" 21 | [task-id predecessors] 22 | (mapv (fn[predecessor] [task-id predecessor]) predecessors)) 23 | 24 | (defn gen-all-precedence-edges 25 | "Given tasks, computes all the edges present in this graph" 26 | [tasks] 27 | (let [raw-maps (map (fn [[k v]] [k (:predecessors v)]) 28 | tasks)] 29 | (mapcat (fn [[k v]] (gen-precendence-edge k v) ) raw-maps))) 30 | 31 | (defn vertices 32 | [edges] 33 | (->> edges 34 | (mapcat identity ) 35 | set)) 36 | 37 | (defn successors 38 | [vertex edges] 39 | (->> edges 40 | (filter (comp (partial = vertex) first)) 41 | (map second))) 42 | 43 | (defn graph-cycles 44 | "Uses [Tarjan]((https://en.wikipedia.org/wiki/Tarjan%27s_strongly_connected_components_algorithm)'s 45 | strongly connectect components algorithm to find if there are any 46 | cycles in a graph" 47 | [edges] 48 | (let [index (atom 0) 49 | indices (atom {}) ;;{vertex index, ...} 50 | lowlinks (atom {}) 51 | S (atom (list));;{vertex lowlink} 52 | output (atom [])] 53 | (letfn [(strong-connect [v] 54 | (swap! indices assoc-in [v] @index) 55 | (swap! lowlinks assoc-in [v] @index) 56 | (swap! index inc) 57 | (swap! S conj v) 58 | (let [succs (successors v edges)] 59 | (doseq [w succs] 60 | (if (not (contains? @indices w)) 61 | (do (strong-connect w) 62 | (swap! lowlinks assoc-in [v] (min (get @lowlinks v) 63 | (get @lowlinks w)))) 64 | (if (some #{w} @S ) 65 | (swap! lowlinks assoc-in [v] (min (get @lowlinks v) 66 | (get @indices w)))))) 67 | (if (= (get @lowlinks v) 68 | (get @indices v)) 69 | (loop [w (peek @S) 70 | r []] 71 | (swap! S pop) 72 | (if (not (= v w)) 73 | (recur (peek @S) 74 | (conj r w)) 75 | (when-not (empty? r) 76 | (swap! output conj (conj r w))))))))] 77 | (doseq [v (vertices edges)] 78 | (when-not (get @indices v) 79 | (strong-connect v))) 80 | @output))) 81 | -------------------------------------------------------------------------------- /CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Contributor Covenant Code of Conduct 2 | 3 | ## Our Pledge 4 | 5 | In the interest of fostering an open and welcoming environment, we as 6 | contributors and maintainers pledge to making participation in our project and 7 | our community a harassment-free experience for everyone, regardless of age, body 8 | size, disability, ethnicity, gender identity and expression, level of experience, 9 | nationality, personal appearance, race, religion, or sexual identity and 10 | orientation. 11 | 12 | ## Our Standards 13 | 14 | Examples of behavior that contributes to creating a positive environment 15 | include: 16 | 17 | * Using welcoming and inclusive language 18 | * Being respectful of differing viewpoints and experiences 19 | * Gracefully accepting constructive criticism 20 | * Focusing on what is best for the community 21 | * Showing empathy towards other community members 22 | 23 | Examples of unacceptable behavior by participants include: 24 | 25 | * The use of sexualized language or imagery and unwelcome sexual attention or 26 | advances 27 | * Trolling, insulting/derogatory comments, and personal or political attacks 28 | * Public or private harassment 29 | * Publishing others' private information, such as a physical or electronic 30 | address, without explicit permission 31 | * Other conduct which could reasonably be considered inappropriate in a 32 | professional setting 33 | 34 | ## Our Responsibilities 35 | 36 | Project maintainers are responsible for clarifying the standards of acceptable 37 | behavior and are expected to take appropriate and fair corrective action in 38 | response to any instances of unacceptable behavior. 39 | 40 | Project maintainers have the right and responsibility to remove, edit, or 41 | reject comments, commits, code, wiki edits, issues, and other contributions 42 | that are not aligned to this Code of Conduct, or to ban temporarily or 43 | permanently any contributor for other behaviors that they deem inappropriate, 44 | threatening, offensive, or harmful. 45 | 46 | ## Scope 47 | 48 | This Code of Conduct applies both within project spaces and in public spaces 49 | when an individual is representing the project or its community. Examples of 50 | representing a project or community include using an official project e-mail 51 | address, posting via an official social media account, or acting as an appointed 52 | representative at an online or offline event. Representation of a project may be 53 | further defined and clarified by project maintainers. 54 | 55 | ## Enforcement 56 | 57 | Instances of abusive, harassing, or otherwise unacceptable behavior may be 58 | reported by contacting the project team at rafik.naccache@gmail.com. All 59 | complaints will be reviewed and investigated and will result in a response that 60 | is deemed necessary and appropriate to the circumstances. The project team is 61 | obligated to maintain confidentiality with regard to the reporter of an incident. 62 | Further details of specific enforcement policies may be posted separately. 63 | 64 | Project maintainers who do not follow or enforce the Code of Conduct in good 65 | faith may face temporary or permanent repercussions as determined by other 66 | members of the project's leadership. 67 | 68 | ## Attribution 69 | 70 | This Code of Conduct is adapted from the [Contributor Covenant][homepage], version 1.4, 71 | available at [http://contributor-covenant.org/version/1/4][version] 72 | 73 | [homepage]: http://contributor-covenant.org 74 | [version]: http://contributor-covenant.org/version/1/4/ 75 | -------------------------------------------------------------------------------- /test/milestones/dyna_scheduler_test.clj: -------------------------------------------------------------------------------- 1 | (ns milestones.dyna-scheduler-test 2 | (:require [milestones.dyna-scheduler :refer :all] 3 | [clojure.test :refer :all])) 4 | 5 | (def correct-tasks {1 {:task-name "Bring bread" 6 | :resource-id "mehdi" 7 | :duration 5 8 | :priority 1 9 | :predecessors []} 10 | 11 | 2 {:task-name "Bring butter" 12 | :resource-id "rafik" 13 | :duration 5 14 | :priority 1 15 | :predecessors []} 16 | 17 | 3 {:task-name "Put butter on bread" 18 | :resource-id "salma" 19 | :duration 3 20 | :priority 1 21 | :predecessors [1 2]} 22 | 23 | 4 {:task-name "Eat toast" 24 | :resource-id "rafik" 25 | :duration 4 26 | :priority 1 27 | :predecessors [3]} 28 | 29 | 5 {:task-name "Eat toast" 30 | :resource-id "salma" 31 | :duration 4 32 | :priority 1 33 | :predecessors [3]} 34 | 35 | ;; now some milestones 36 | 6 {:task-name "Toasts ready" 37 | :is-milestone true 38 | :predecessors [3]}}) 39 | 40 | (def correct-tasks-schedule 41 | (schedule correct-tasks [:priority])) 42 | 43 | ;; test if correct-tasks-schedule :errors is nil 44 | (deftest correct-tasks-pass 45 | (testing "Correct tasks have no error.") 46 | (is (= true 47 | (nil? (:error correct-tasks-schedule))))) 48 | 49 | ;; test if task 6 is scheduled after 3 50 | (deftest tasks-are-correctly-scheduled) 51 | (testing "test if task 6 is scheduled after 3") 52 | (is (= true 53 | (> 54 | (get-in correct-tasks-schedule [:result 6 :begin] ) 55 | (get-in correct-tasks-schedule [:result 3 :begin] )))) 56 | 57 | ;; Detecting cycles 58 | 59 | (def cyclic-tasks {1 {:task-name "task 1" 60 | :resource-id "mehdi" 61 | :duration 5 62 | :priority 1 63 | :predecessors [3]} 64 | 65 | 2 {:task-name "task 2" 66 | :resource-id "rafik" 67 | :duration 5 68 | :priority 1 69 | :predecessors [1]} 70 | 71 | 3 {:task-name "task 3" 72 | :resource-id "salma" 73 | :duration 3 74 | :priority 1 75 | :predecessors [2]}}) 76 | 77 | (deftest has-cycle-errors 78 | (testing "Detect cycles in tasks definition graphs.") 79 | (is (= [[2 3 1]] 80 | (get-in 81 | (schedule cyclic-tasks [:priority]) 82 | [:errors :tasks-cycles])))) 83 | 84 | ;; task 3 has no resource but is no milestone, 85 | ;; task 1 is a milestone, so only task 3 should be reported 86 | (def tasks-w-no-resource {3 {:task-name "task 3" 87 | :duration 3 88 | :priority 1 89 | :predecessors []} 90 | 91 | 1 {:task-name "milestone 1" 92 | :duration 3 93 | :priority 1 94 | :is-milestone true 95 | :predecessors [3]}}) 96 | 97 | (deftest verify-resources-for-tasks 98 | (testing " task 3 has no resource but is no milestone,task 1 is a milestone, so only task 3 should be reported") 99 | (is (= 100 | [3] 101 | (get-in 102 | (schedule tasks-w-no-resource [:priority]) 103 | [:errors :tasks-w-no-resources])))) 104 | 105 | 106 | ;; some tasks with inexisting predecessors 107 | (def tasks-w-predecessors-errors {3 {:task-name "task 3" 108 | :duration 3 109 | :priority 1 110 | :predecessors [17]} 111 | 112 | 1 {:task-name "task 1" 113 | :duration 3 114 | :priority 1 115 | :predecessors []}}) 116 | (deftest tasks-inexistent-preds 117 | (testing "Some tasks with inexisting predecessors") 118 | (is 119 | (= 120 | {3 [17]} 121 | (get-in 122 | (schedule tasks-w-predecessors-errors [:priority]) 123 | [:errors :tasks-w-predecessors-errors])))) 124 | 125 | ;; Some tasks that do not contain the ordering field 126 | (def tasks-w-reordering-errors {3 {:task-name "task 3" 127 | :duration 3 128 | :predecessors []} 129 | 130 | 1 {:task-name "task 1" 131 | :duration 3 132 | :priority 1 133 | :predecessors [3]}}) 134 | 135 | (deftest tatks-reordering-issues 136 | (testing "Some tasks that do not contain the ordering field") 137 | (is (= 138 | {3 [:priority]} 139 | (get-in 140 | (schedule tasks-w-reordering-errors [:priority]) 141 | [:errors :reordering-errors])))) 142 | 143 | 144 | ;; Milestones with no predecessors errors 145 | (def milestones-w-no-predecessors {3 {:task-name "task 3" 146 | :duration 3 147 | :priority 1 148 | :predecessors []} 149 | 150 | 1 {:task-name "milestone 1" 151 | :duration 3 152 | :priority 1 153 | :is-milestone true 154 | :predecessors []}}) 155 | (deftest tasks-w-no-preds 156 | (testing "Some tasks that do not contain the ordering field") 157 | (is (= 158 | [1] 159 | (get-in 160 | (schedule milestones-w-no-predecessors [:priority]) 161 | [:errors :milestones-w-no-predecessors])))) 162 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Milestones - The Automagic Project Planner 2 | ============================================= 3 | 4 | [![License MIT](https://img.shields.io/badge/License-MIT-blue.svg)](http://opensource.org/licenses/MIT) 5 | [![Build Status](https://travis-ci.org/turbopape/milestones.svg?branch=master)](https://travis-ci.org/turbopape/milestones) 6 | [![Clojars Project](https://img.shields.io/clojars/v/org.clojars.turbopape/milestones.svg)](https://clojars.org/org.clojars.turbopape/milestones) 7 | [![#milestones on slack channel](https://img.shields.io/badge/chat-%23%20team-yellowgreen.svg)](https://automagic-tools.slack.com/signup) 8 | 9 | Automagic logo 11 | 12 | > "Any sufficiently advanced technology is indistinguishable from magic" 13 | - According to Clarke's 3rd Law 14 | 15 | 16 | Milestones is a Clojure and ClojureScript library that needs only your project's task description in order to generate the best possible schedule for you. This is based on the priorities of the tasks that you have set (in terms of fields in tasks, more about this in a second). 17 | 18 | Constraints on tasks are: 19 | - Resources (i.e, which resource is needed to perform a particular task), 20 | - The task's duration 21 | - Predecessors (i.e, which tasks need to be done before a particular task can be fired). 22 | 23 | Based on the above constraints, Milestones either generates 24 | the schedule (if it does not detect scheduling errors) or shows you any kind 25 | of error it may have found. 26 | 27 | Tasks are basically build up out of a map containing IDs as keys and information about 28 | the tasks as values. Information about a task is itself a map of 29 | associating fields to values; here is an example: 30 | 31 | ```Clojure 32 | { 1 { :task-name "A description about this task" 33 | :resource-id 2 34 | :duration 5 :priority 1} 35 | 36 | 2 {:task-name "A description about this task" 37 | :resource-id 1 38 | :duration 4 39 | :priority 1 40 | :predecessors [1]} } 41 | ``` 42 | 43 | Milestones tries to detect any circular dependencies (tasks 44 | that depend on themselves or tasks that end up depending on 45 | themselves). The task's definition must be a directed 46 | non-cyclical graph. 47 | 48 | Tasks (that are not milestones) without a resource-id won't be scheduled and will be reported as erroneous. 49 | 50 | 51 | Special tasks with `:is-milestone "whatever"` are milestones. They are assigned a random user 52 | and a duration 1, so they can enter the computation like ordinary tasks. 53 | They must have predecessors, otherwise they will be reported as erroneous. 54 | 55 | If nothing went wrong during the generation process, the output of Milestones is a schedule. It will be 56 | comprised of the very same tasks mapped with a `:begin` field, telling us when to begin each task. 57 | The time for each task is represented as an integer value. 58 | 59 | 60 | ```Clojure 61 | { 1 { :task-name "A description about this task" 62 | :resource-id 2 63 | :duration 5 64 | :priority 1 65 | :begin 0} 66 | 67 | 2 {:task-name "A description about this task" 68 | :resource-id 1 69 | :duration 4 70 | :priority 1 71 | :predecessors [1] :begin 5} } 72 | ``` 73 | 74 | 75 | ## See Milestones OnLine 76 | 77 | You can see Milestones in 78 | action [here.](http://turbopape.github.io/milestones). We 79 | use 80 | [Google Charts Lib](https://developers.google.com/chart/interactive/docs/gallery/ganttchart) to 81 | draw GANTT Charts, and in some-way we rely on this library time 82 | resolution mechanisms to be able to mix different time units for 83 | different tasks. Actually, tasks on web can have time units, and you 84 | can get a real schdule based on duration expressed in actual time 85 | units! Currently, the web interface schedules tasks starting from 86 | today. 87 | Also, Priority and predecessors are optional in the web 88 | interface. This is related to the natural language implementation, but 89 | roughly speaking this means that if you omit these clauses in your 90 | task descriptions, the system will forgive you. 91 | 92 | The Web version is being lifted to use the newly developed NLP 93 | library: [postagga](https://github.com/turbopape/postagga). Now 94 | milestones will host the scheduling library, the NLP facilities etc 95 | has moved to this new project. 96 | 97 | ## Installation 98 | 99 | You can grab Milestones from clojars. Using Leiningen, you put the dependency in the **:dependencies** section in your project.clj: 100 | 101 | [![Clojars Project](https://img.shields.io/clojars/v/org.clojars.turbopape/milestones.svg)](https://clojars.org/org.clojars.turbopape/milestones) 102 | 103 | ## Usage 104 | 105 | Start the library using the **schedule** function. 106 | Pass a map to it containing tasks and a vector containing the 107 | properties that define how the scheduler will prioritize the tasks. 108 | Priorities at the left are considered first. The lower the number, the earlier it is scheduled. 109 | Say you want to schedule tasks with lower `:priority` and then lower `:duration`, first do: 110 | 111 | ```Clojure 112 | (schedule tasks [:priority :duration]) 113 | ``` 114 | 115 | It returns tasks with **`:begin`** fields, or an error 116 | 117 | ```Clojure 118 | {:errors nil 119 | 120 | :result {1 {**:begin** }}} 121 | ``` 122 | 123 | Or: 124 | 125 | ```Clojure 126 | {:errors {:reordering-errors reordering-errors 127 | :tasks-w-predecessors-errors tasks-predecessors-errors 128 | :tasks-cycles tasks-cycles 129 | :milestones-w-no-predecessors milestones-w-no-predecessors} 130 | 131 | :result nil} 132 | ``` 133 | 134 | ### Sample Case 135 | 136 | For example, if you have tasks defined to: 137 | 138 | ```Clojure 139 | { 140 | 1 {:task-name "Bring bread" 141 | :resource-id "mehdi" 142 | :duration 5 143 | :priority 1 144 | :predecessors []} 145 | 146 | 2 {:task-name "Bring butter" 147 | :resource-id "rafik" 148 | :duration 5 149 | :priority 1 150 | :predecessors []} 151 | 152 | 3 {:task-name "Put butter on bread" 153 | :resource-id "salma" 154 | :duration 3 155 | :priority 1 156 | :predecessors [1 2]} 157 | 158 | 4 {:task-name "Eat toast" 159 | :resource-id "rafik" 160 | :duration 4 161 | :priority 1 162 | :predecessors [3]} 163 | 164 | 5 {:task-name "Eat toast" 165 | :resource-id "salma" 166 | :duration 4 167 | :priority 1 168 | :predecessors [3]} 169 | 170 | ;; now some milestones 171 | 6 {:task-name "Toasts ready" 172 | :is-milestone true 173 | :predecessors [3]}} 174 | ``` 175 | you would want to run 176 | 177 | ```Clojure 178 | (schedule tasks [:duration]) 179 | ``` 180 | 181 | and you'd have: 182 | 183 | ```Clojure 184 | {:error nil, 185 | :result { 186 | ;;tasks with :begin field, i.e at what time shall they be fired. 187 | 1 188 | {:achieved 5, 189 | :begin 1, 190 | :task-name "Bring bread", 191 | :resource-id "mehdi", 192 | :duration 5, 193 | :priority 1, 194 | :predecessors []}, 195 | 2 196 | {:achieved 5, 197 | :begin 1, 198 | :task-name "Bring butter", 199 | :resource-id "rafik", 200 | :duration 5, 201 | :priority 1, 202 | :predecessors []}, 203 | 3 204 | {:resource-id "salma", 205 | :achieved 3, 206 | :duration 3, 207 | :predecessors [1 2], 208 | :begin 6, 209 | :task-name "Put butter on bread", 210 | :priority 1}, 211 | 4 212 | {:resource-id "rafik", 213 | :achieved 4, 214 | :duration 4, 215 | :predecessors [3], 216 | :begin 9, 217 | :task-name "Eat toast", 218 | :priority 1}, 219 | 5 220 | {:resource-id "salma", 221 | :achieved 4, 222 | :duration 4, 223 | :predecessors [3], 224 | :begin 9, 225 | :task-name "Eat toast", 226 | :priority 1}, 227 | 6 228 | {:achieved 1, 229 | :duration 1, 230 | :predecessors [3], 231 | :begin 9, 232 | :task-name "Toasts ready", 233 | :is-milestone true}}} 234 | ``` 235 | 236 | You can then pass this to another program to render as a Gantt chart (ours is coming soon). 237 | You should have `:achieved` equal to `:duration`, or Milestones will not be able to schedule all of the tasks (this 238 | should not happen). 239 | 240 | ### Errors 241 | 242 | Error Map Key | What it means 243 | -------------------------------|----------------------------- 244 | :unable-to-schedule | Something made it impossible for the recursive algorithm to terminate... 245 | :reordering-errors | { 1 [:priority],...} You gave priority to tasks according to fields (:priority) which some tasks (1) lack). 246 | :tasks-w-predecessors-errors | :{6 [13],...} These tasks have these non-existent predecessors. 247 | :tasks-w-no-resources | [1,... These tasks are not milestones and are not assigned to any resource. 248 | :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. 249 | :milestones-w-no-predecessors | [1 2... These milestones don't have predecessors. 250 | 251 | ## History 252 | 253 | The concept of auto-magic project scheduling is inspired from **the great** 254 | [Taskjuggler.](http://www.taskjuggler.org). 255 | 256 | The first prototype of Milestones was built as an entry to the Clojure 257 | Cup 2014. You can find the code and some technical explanation of the 258 | algorithms in use (core.async, etc...) 259 | [here.](https://github.com/turbopape/milestones-clojurecup2014) 260 | 261 | as of version 0.2.X and above, milestone uses a purely functional 262 | algorithm using the same logic of assigning work units, but simply 263 | relying on recur to advance the system status. 264 | 265 | Although the prototype showcases the main idea, this repository is the official one, i.e, contains latest versions and is more thoroughly tested. 266 | 267 | ## Code Of Conduct 268 | Please note that this project is released with a [Contributor Code of Conduct](./CODE_OF_CONDUCT.md). By participating in this project you agree to abide by its terms. 269 | 270 | ## License and Credits 271 | 272 | Copyright © 2016 Rafik Naccache and [Contributors](./CONTRIBUTORS.md). Distributed under the terms of the [MIT License](https://github.com/turbopape/milestones/blob/master/LICENSE). 273 | 274 | All Libraries used in this project (see project.clj) are owned by their respective authors and their respective licenses apply. 275 | 276 | The Logo is created by my talented friend the great [Chakib Daoud](https://www.facebook.com/3amettaher/?fref=ts) 277 | -------------------------------------------------------------------------------- /src/milestones/dyna_scheduler.cljc: -------------------------------------------------------------------------------- 1 | ;; 2 | ;; Copyright (C) 2016 , Rafik NACCACHE 3 | 4 | (ns milestones.dyna-scheduler 5 | (:require 6 | [milestones.graph-utilities :refer [graph-cycles 7 | predecessors-of-task-exist? 8 | gen-all-precedence-edges]])) 9 | 10 | (defn gen-work-flow 11 | "Given all tasks description vector [{:task-id, ...},{}] 12 | and a work-queue [1 2 3],... we generate named task units 13 | with as many unit of each task as its duration : 14 | [1 1 1 2 2 3 3 3]" 15 | [tasks 16 | work-queue] 17 | (->> work-queue 18 | (mapcat #(let [the-id % 19 | the-task (get tasks %) ] 20 | (repeat (:duration the-task) the-id))) 21 | (vec))) 22 | 23 | (defn task-completion-rate 24 | "Given tasks description, a schedule-output 25 | [{:task-id 1 :resource-id 1 :time 2} 26 | {:task-id 1 :resource-id 1 :time 2} ...] 27 | and a task-id, returns the completion-rate,i.e, 28 | nb of units in output / duration of task. if no task in the schedule, 29 | it's completion is 0. If no duration / 0, completion is 1. " 30 | [tasks 31 | output-schedule 32 | the-task-id] 33 | (try 34 | (let [the-task (get tasks the-task-id) 35 | duration (the-task :duration) 36 | nb-task-units-in-output (count 37 | (filter #(= (% :task-id ) the-task-id ) 38 | output-schedule ))] 39 | (/ nb-task-units-in-output duration)) 40 | (catch 41 | #?(:clj Exception 42 | :cljs js/Error.) 43 | e 44 | 1))) 45 | 46 | (defn task-complete? 47 | "Returns true if task is complete" 48 | [tasks 49 | output-schedule 50 | the-task-id] 51 | (= (task-completion-rate tasks 52 | output-schedule 53 | the-task-id) 54 | 1)) 55 | 56 | (defn all-tasks-complete? 57 | [tasks 58 | output-schedule] 59 | (every? (partial task-complete? 60 | tasks 61 | output-schedule) 62 | (keys tasks))) 63 | 64 | (defn work-in-progress-count 65 | "Work in progress is a task at the peek of the work flow [ 1 1 2 2 2 ...], 66 | that a resource begun treating. Once a task is Work in progress, 67 | it is not involved in the reordering of tasks, unless its length 68 | is equal to the original task duration : it has not yet been processed." 69 | [work-flow 70 | the-task-id] 71 | (count (take-while #(= the-task-id %) 72 | (reverse work-flow)))) 73 | 74 | (defn task-in-work-in-progress? 75 | "Returns true if task is work-in-progress, 76 | i.e, is in the head of the work queue, and is not at full length" 77 | [tasks 78 | work-flow 79 | the-task-id] 80 | (let [wp-count (work-in-progress-count work-flow the-task-id)] 81 | (and (pos? 0) 82 | (not= (get (tasks the-task-id) :duration) 83 | wp-count)))) 84 | 85 | (defn all-predecessors-complete? 86 | "A predicate that returns true if all predecessors have been completed " 87 | [tasks 88 | output-schedule 89 | task-id] 90 | (let [the-task (get tasks task-id) 91 | preds (get the-task :predecessors)] 92 | (every? (partial task-complete? 93 | tasks 94 | output-schedule) 95 | preds))) 96 | 97 | (defn find-fireable-tasks 98 | "Finds which tasks can be fired based on their predecessors." 99 | [tasks 100 | output-schedule] 101 | (vec 102 | (filter (partial all-predecessors-complete? tasks output-schedule) 103 | (keys tasks)))) 104 | 105 | (defn properties 106 | "Inspired from the joy of clojure. Knew I was going to use it someday! 107 | This yields a function which, applied to each task by sort-by, 108 | will generate vector of values used to order the tasks 109 | don't forget we have rows with indices, {1 {:order ...}" 110 | [property-names] 111 | (fn [row-with-index] 112 | (vec 113 | (mapcat 114 | #(map (comp % val) row-with-index) 115 | property-names )))) 116 | 117 | (defn reorder-tasks 118 | "Sort tasks according to properties given in the property-names 119 | vector. As it is a vector, accessing from right is more effcient. as more 120 | urgent comes first, i.e on left of the vector, we need to reverse 121 | the result to put highest priority to the right." 122 | [tasks 123 | property-names] 124 | (vec (reverse 125 | (mapcat keys (sort-by (properties property-names) 126 | (map (fn [[k v]] {k v}) tasks)))))) 127 | 128 | (defn tasks-for-resource 129 | "Given a user-id, give you all tasks for this user (with all infos)" 130 | [tasks resource-id] 131 | (filter #(= resource-id (:resource-id (val %))) tasks)) 132 | 133 | (defn task-sched-time-vector 134 | "Given an output-schedule, and a task-id you get a time-vector 135 | of the task as present in the output schedule" 136 | [output-schedule 137 | task-id] 138 | (->> output-schedule 139 | (group-by :task-id) 140 | (#(get %1 task-id)) 141 | (map :time) 142 | (vec))) 143 | 144 | 145 | (defn format-a-task-in-output-schedule 146 | "Given a task, we compute its current time vector 147 | and inject begin-time and completion ratio in it" 148 | [output-schedule 149 | a-task] 150 | (let [[k v] a-task 151 | the-tv (task-sched-time-vector output-schedule k)] 152 | (if (seq the-tv) 153 | [k (-> v 154 | (assoc :begin (apply min the-tv)) 155 | (assoc :achieved (count the-tv)))] 156 | a-task))) 157 | 158 | (defn format-tasks-in-output-schedule 159 | "Given an output schedule : 160 | [{:task-id 1 :time 1 :resource-id 1} 161 | {:task-id 3 :time 1 :resource-id 1} 162 | {:task-id 1 :time 2 :resource-id 1} 163 | {:task-id 3 :time 2 :resource-id 1} 164 | {:task-id 3 :time 3 :resource-id 1}] 165 | we find start-time, completion rate for each task and then we return 166 | a scheduled version of tasks. {1 {:begin 2 :completion-rate 2/5....})" 167 | [output-schedule 168 | tasks] 169 | (into {} 170 | (map (partial format-a-task-in-output-schedule 171 | output-schedule) 172 | tasks))) 173 | 174 | (defn work-flow-for-resource 175 | "given a user, its current work-queue, tasks and current output schedule, 176 | we find his tasks, the fireable ones, reorder all of them (if preemptive) 177 | or those non work in propress if not, and issue new work-flow" 178 | [current-work-flow 179 | tasks 180 | resource-id 181 | current-output-schedule 182 | reordering-properties] 183 | (let [fireable-tasks-ids (find-fireable-tasks tasks 184 | current-output-schedule) 185 | fireable-tasks (select-keys tasks 186 | fireable-tasks-ids) 187 | his-fireable-tasks (tasks-for-resource fireable-tasks 188 | resource-id) 189 | his-incomplete-fireable-tasks (into {} 190 | (filter #(not (task-complete? 191 | tasks 192 | current-output-schedule 193 | (key %))) 194 | his-fireable-tasks)) 195 | his-incomplete-fireable-tasks-ids (keys his-incomplete-fireable-tasks) 196 | ;; id of the task to be kept, work in progress 197 | fireable-id-in-wp (first (filter (partial task-in-work-in-progress? 198 | tasks 199 | current-work-flow) 200 | his-incomplete-fireable-tasks-ids)) 201 | wp-vector (vec (repeat (work-in-progress-count current-work-flow 202 | fireable-id-in-wp) 203 | fireable-id-in-wp)) 204 | ;; [ the part to be reordered and generated] 205 | fireable-ids-not-in-wp (vec 206 | (remove #(= % fireable-id-in-wp) 207 | his-incomplete-fireable-tasks-ids )) 208 | his-fireable-tasks-not-in-wp (select-keys tasks fireable-ids-not-in-wp) 209 | his-ordered-tasks-not-in-wp (reorder-tasks his-fireable-tasks-not-in-wp 210 | reordering-properties) 211 | his-new-ordered-workflow (gen-work-flow tasks 212 | his-ordered-tasks-not-in-wp)] 213 | ;; will be used to sync the threads, on for each resource 214 | (into his-new-ordered-workflow wp-vector))) 215 | 216 | (defn run-scheduler-for-resource 217 | "For this timer, computes aht task unit this resource will compute, 218 | yielding a new workflows map" 219 | [timer 220 | resource-id 221 | tasks 222 | output-schedule 223 | workflows 224 | reordering-properties] 225 | 226 | (let [current-flow-for-resource (get workflows resource-id) 227 | my-workflow (work-flow-for-resource current-flow-for-resource 228 | tasks 229 | resource-id 230 | output-schedule 231 | reordering-properties) 232 | the-task-unit {:task-id (peek my-workflow) 233 | :time timer 234 | :resource-id resource-id}] 235 | 236 | {:task-unit the-task-unit 237 | :new-workflows (if (seq my-workflow) 238 | (assoc workflows 239 | resource-id 240 | (pop my-workflow)))})) 241 | 242 | (defn total-task-duration 243 | "Computes total tasks duration as if they were done sequentially." 244 | [tasks] 245 | (->> tasks 246 | ( vals) 247 | (map :duration ) 248 | (filter (comp not nil?)) 249 | (reduce +))) 250 | 251 | 252 | (defn move-system-status-gen 253 | [tasks 254 | reordering-properties 255 | timer 256 | resources-ids 257 | output-schedule 258 | workflows] 259 | 260 | ;=> {:task-unit t :workflow wf} 261 | (if (seq resources-ids) 262 | (let [resource (first resources-ids) 263 | new-system-status (run-scheduler-for-resource timer 264 | resource 265 | tasks 266 | output-schedule 267 | workflows 268 | reordering-properties)] 269 | (recur 270 | tasks 271 | reordering-properties 272 | timer 273 | (rest resources-ids) 274 | (let [new-task-unit (get new-system-status :task-unit)] 275 | (if (get new-task-unit :task-id) 276 | (conj output-schedule new-task-unit) 277 | output-schedule)) 278 | (get new-system-status :new-workflows))) 279 | {:new-output-schedule output-schedule 280 | :new-workflows workflows})) 281 | 282 | (defn run-scheduler 283 | "this is the master-mind. runs all of them, collects their inputs, 284 | and then goes home" 285 | [tasks 286 | reordering-properties] 287 | (let [max-time (* 2 (total-task-duration tasks)) 288 | resources-ids (set (map :resource-id (vals tasks))) 289 | move-system-status (partial move-system-status-gen 290 | tasks reordering-properties)] 291 | (loop [timer 1 292 | workflows {} 293 | output-schedule []] 294 | (cond 295 | (and (< timer max-time) 296 | (not (all-tasks-complete? tasks 297 | output-schedule))) (let [{:keys 298 | [new-output-schedule 299 | new-workflows]} (move-system-status timer 300 | resources-ids 301 | output-schedule 302 | workflows)] 303 | (recur (inc timer) 304 | new-workflows 305 | new-output-schedule)) 306 | (all-tasks-complete? tasks 307 | output-schedule) output-schedule 308 | :else nil)))) 309 | 310 | 311 | (defn missing-prop-for-task 312 | "Given a task ({:prop ...}) and a vector of properties 313 | returns missing properties for task" 314 | [task 315 | reordering-properties] 316 | (vec (filter (comp not nil?) 317 | (map #(if ((comp not (partial contains? task)) % ) %) 318 | reordering-properties)))) 319 | 320 | (defn tasks-w-missing-properties 321 | "Returns a map, with task-id and a vector of missing property" 322 | [tasks 323 | reordering-properties] 324 | (into {} (for [[id t] tasks 325 | :let [missing-props (missing-prop-for-task t 326 | reordering-properties)] 327 | :when (seq missing-props)] 328 | {id missing-props}))) 329 | 330 | (defn tasks-w-not-found-predecessors 331 | "Returns the Tasks with predecessors not declared as tasks elsewhere in the tasks definition." 332 | [tasks] 333 | (keys (filter 334 | (fn [[_ t]] (not (predecessors-of-task-exist? tasks 335 | t))) 336 | tasks))) 337 | 338 | (defn tasks-w-no-field 339 | "Which tasks don't have Field field." 340 | [tasks field] 341 | (filter (comp not field val) tasks)) 342 | 343 | (defn tasks-w-empty-predecessors 344 | [tasks] 345 | (vec (keys (into {} (filter (comp empty? val) 346 | (into {} 347 | (map 348 | (fn [[id t]] {id (:predecessors t)}) 349 | tasks))))))) 350 | (defn not-found-task? 351 | "If task id is not in tasks, return true" 352 | [tasks task-id] 353 | (not 354 | (contains? 355 | (set (keys tasks)) 356 | task-id))) 357 | 358 | (defn tasks-w-non-existent-predecessors 359 | "Given Tasks, emits a detailed info on whom tasks are having non existent 360 | predecessors" 361 | [tasks] 362 | (into {} 363 | (filter 364 | (comp seq #(get % 1)) 365 | (map (fn [[id t]] 366 | [id (vec (filter (partial not-found-task? tasks) 367 | (:predecessors t)))]) 368 | tasks)))) 369 | 370 | (defn errors-on-tasks 371 | "verif if there-s something wrong before we schedule. 372 | emits a map. {:errors {} :results schedule 373 | errors : non existing reordering prop, non existing predecessors, and cycles." 374 | [tasks 375 | reordering-properties] 376 | (let [milestone-tasks (into {} (filter (comp :is-milestone val) tasks)) 377 | non-milestone-tasks (into {} (tasks-w-no-field tasks :is-milestone)) 378 | reordering-errors (tasks-w-missing-properties non-milestone-tasks 379 | reordering-properties) 380 | tasks-graph (gen-all-precedence-edges tasks) 381 | tasks-cycles (graph-cycles tasks-graph) 382 | milestones-w-no-predecessors (tasks-w-no-field milestone-tasks 383 | :predecessors) 384 | tasks-w-no-resources (tasks-w-no-field non-milestone-tasks 385 | :resource-id)] 386 | {:reordering-errors reordering-errors 387 | :tasks-w-predecessors-errors (tasks-w-non-existent-predecessors tasks) 388 | :tasks-w-no-resources (into [] (keys tasks-w-no-resources)) 389 | :tasks-cycles tasks-cycles 390 | :milestones-w-no-predecessors (into (into [] (keys milestones-w-no-predecessors)) 391 | (tasks-w-empty-predecessors milestone-tasks))})) 392 | 393 | (defn prepare-milestone 394 | "A milestone is declared by giving :milestone-name and at least one predecessor 395 | then we create a task, with a (gensym :milestone-user) and a duration 1 as user-id, so milestones 396 | can enter the scheduler algorithm" 397 | [a-milestone-desc] 398 | (assoc (assoc a-milestone-desc :duration 1) 399 | :resource-id (gensym :milestone-user))) 400 | 401 | (defn prepare-tasks 402 | "Adds random user-ids and duration=1 to milestones tasks" 403 | [tasks] 404 | (let [milestone-tasks (filter (comp :is-milestone val) 405 | tasks) 406 | curated-milestone-tasks (map (fn [[id t]] [id (prepare-milestone t)]) 407 | milestone-tasks)] 408 | (into tasks curated-milestone-tasks))) 409 | 410 | (defn schedule 411 | "The real over-master-uber-function to call. Gives you tasks with :begin, 412 | just like you'd exepct, if errors =nil, or you can read errors instead." 413 | [tasks 414 | reordering-properties] 415 | (let [errors (errors-on-tasks tasks 416 | reordering-properties)] 417 | (if (every? (comp nil? seq) (vals errors)) 418 | (let [curated-tasks (prepare-tasks tasks)] 419 | (if-let [result (run-scheduler curated-tasks 420 | reordering-properties)] 421 | {:errors nil 422 | :result (format-tasks-in-output-schedule result tasks)} 423 | 424 | {:result nil 425 | :errors :unable-to-schedule})) 426 | {:result nil 427 | :errors (into {} (filter (comp not nil? val) errors))}))) 428 | --------------------------------------------------------------------------------