Browse files

Improvements to constraint-based solutions

  • Loading branch information...
1 parent 2ab05ed commit 2c54470ea632778564f1b1389d6418136a29a6e5 @lvh committed Mar 6, 2014
Showing with 41 additions and 19 deletions.
  1. +27 −12 src/hood/constraint.clj
  2. +14 −7 test/hood/constraint_test.clj
View
39 src/hood/constraint.clj
@@ -3,28 +3,43 @@
[loco.core :refer [solution]]
[loco.constraints :refer :all]])
-(defn alloc
+(defn ^:private alloc-vars
+ "The allocation constraint variables for a seq of applications."
+ [apps]
+ (for [a apps] [:allocation a]))
+
+(defn grant-constraint
+ "An application will get between zero and the requested amount of
+ dollars."
+ [app]
+ ($in [:allocation app] 0 (:requested app)))
+
+(defn ^:private solve
+ "Throw the constraint problem into loco."
+ [apps budget target]
+ (let [allocs (alloc-vars apps)
+ grant-constraints (map grant-constraint apps)
+ within-budget ($<= (apply $+ allocs) budget)
+ constraints (conj grant-constraints within-budget)]
+ (solution constraints :maximize target)))
+
+(defn ^:private soln-to-map
+ [soln]
+ (into {} (for [[[tag application] grant] soln] [application grant])))
+
+(def alloc
"Allocates using a constraint solver.
apps is a seq of all applications.
budget is the total budget.
target is the term to optimize.
"
- [apps budget target]
- (let [n (count apps)
- allocs (for [i (range (count apps))] [:allocation i])
- grant-constrs (for [i (range n)]
- ($in [:allocation i]
- 0 (:requested (apps i))))
- budget-constr ($<= (apply $+ allocs) budget)
- constraints (conj grant-constrs budget-constr)]
- (solution constraints :maximize target)))
+ (comp soln-to-map solve))
(defn linear-target
[apps score]
(let [ratios (map #(/ (score %) (:requested %)) apps)
scale (/ 100 (- (apply max ratios) (apply min ratios)))
scaled-ratios (vec (map #(long (* scale %)) ratios))
- scaled-allocs (for [i (range (count apps))]
- ($* [:allocation i] (scaled-ratios i)))]
+ scaled-allocs (map $* (alloc-vars apps) scaled-ratios)]
(apply $+ scaled-allocs)))
View
21 test/hood/constraint_test.clj
@@ -2,10 +2,10 @@
(:require [hood.constraint :refer :all]
[clojure.test :refer :all]))
-(def applications
- [{:name "Alice", :score 5, :requested 120}
- {:name "Bob", :score 4, :requested 100}
- {:name "Carol", :score 3, :requested 80}])
+(def alice {:name "Alice", :score 5, :requested 120})
+(def bob {:name "Bob", :score 4, :requested 100})
+(def carol {:name "Carol", :score 3, :requested 80})
+(def applications [alice bob carol])
;; Keep in mind that most applications won't actually have a score
;; attribute. In this case, we're doing it so that the scoring
@@ -23,14 +23,21 @@
(let [subtargets (:args target)]
(and
(= (set (map :type subtargets)) #{:*})
- (= (map :arg1 subtargets) [[:allocation 0] [:allocation 1] [:allocation 2]])
+ (= (map :arg1 subtargets) (#'hood.constraint/alloc-vars applications))
(= (set (map (comp type :arg2) subtargets)) #{Long})))))
(deftest target-tests
(testing "linear target produces k * var constraints"
(is (sane-target? (linear-target applications :score)))))
(deftest alloc-tests
- (testing "linear allocation of test applications"
+ (testing "linear allocation on restricted budget"
(is (= (alloc applications 200 (linear-target applications :score))
- {}))))
+ {alice 120
+ bob 80
+ carol 0})))
+ (testing "linear allocation on complete budget"
+ (is (= (alloc applications 300 (linear-target applications :score))
+ {alice 120
+ bob 100
+ carol 80}))))

0 comments on commit 2c54470

Please sign in to comment.