3
\$\begingroup\$

Here's a job shop scheduler using core.logic. I had a lot of fun coding it. I'd appreciate ideas on how to make the code faster or more readable.

Setup

(ns schejule.no-db
  (:require [clojure.core.logic :refer [== all everyg lvar run run* fresh succeed] :as l]
            [clojure.core.logic.fd :as fd])
  (:refer-clojure :exclude [==]))

(def test-data
  [{:id 1 :job :cooljob :duration 180 :machine 1}
   {:id 2 :job :cooljob :duration 120 :machine 2}
   {:id 3 :job :cooljob :duration 100 :machine 3}
   {:id 4 :job :cooljob :duration 150 :machine 4}
   {:id 5 :job :ajob :duration 180 :machine 1}
   {:id 6 :job :ajob :duration 120 :machine 2}
   {:id 7 :job :ajob :duration 100 :machine 3}
   {:id 8 :job :ajob :duration 150 :machine 4 :startby 300}
   {:id 9 :job :another :duration 180 :machine 1}
   {:id 10 :job :another :duration 120 :machine 2}
   {:id 11 :job :another :duration 100 :machine 3}
   {:id 12 :job :another :duration 150 :machine 3 :startby 400}])

Ratiocinate!

(defn init-jobs
  "Binds tasks in a job to occur in the correct order.
  `lengths` must be a seq of integers defining no. of tasks in nth job."
  [tasks lengths]
  (if (seq lengths)
    (let [l (first lengths)]
      (all
      (everyg (fn [[x y]] (fd/< x y)) (partition 2 1 (take l tasks)))
      (init-jobs (drop l tasks) (next lengths))))
    succeed))

(defn sort-tasks
  "Sorts tasks by `:job`, then by `:id` to prepare for `solvo`"
  [tasks]
  (->> tasks (sort-by :job) (sort-by :id)))

(defn solvo*
  "Find a feasible ordering for tasks.
  tasks **MUST** be sorted by `:job`, then by `:id`."
  [tasks]
  (let [n (count tasks)
        lengths (->> tasks (partition-by :job) (map count))
        vars (repeatedly n lvar)]
    (run* [q]
          (== q vars)
          (init-jobs vars lengths)
          (everyg #(fd/in % (fd/interval (- n 1))) vars)
          (fd/distinct vars))))

(defn constructo*
  "Calls solvo on some tasks, then associates ords with tasks.
  Returns a lazy (possibly huge) sequence."
  [tasks]
  (let [ts (sort-tasks tasks)
        feasible* (solvo* ts)]
    (map (fn [tasks ords]
          (map (fn [t ord]
                  (assoc t :ord ord))
                tasks
                ords))
        (repeat ts)
        feasible*)))

Filter

I'm a bit worried about the (lack of) speed of this gargantuan filter expression!

(some (fn [tasks]
        (reduce (fn [solution task]
                  (let [{:keys [machine duration job id startby]}
                        task

                        prev-machine (get-in solution [:prev-task job])

                        prev-end (max
                                  (or (:end-time (last (get-in solution [:tasks machine]))) 0)
                                  (or (:end-time (get-in solution [:tasks prev-machine])) 0))

                        task-w-end (assoc task :end-time (+ prev-end duration))]

                    (when (and startby (< startby prev-end))
                      (reduced nil))
                    (-> solution
                        (update-in [:tasks machine] #(conj % task-w-end))
                        (assoc-in [:prev-task job] machine))))
                {}
                tasks))
      (map (partial sort-by :ord) (constructo* test-data-2)))
\$\endgroup\$
  • \$\begingroup\$ When I run this, it takes about a minute and then outputs a huge list of things. How can I run it to get a first match? \$\endgroup\$ – Petrus Theron Feb 19 '18 at 10:38
1
\$\begingroup\$

A terser way to write sort-tasks would be:

(sort-by (juxt :job :id) tasks)
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.