Skip to content
Browse files

Some allocation fitness stuff

  • Loading branch information...
1 parent 5aafe01 commit c523e3c0b7e551c575af7b84d09916ba3d758033 @lvh committed
Showing with 65 additions and 0 deletions.
  1. +26 −0 src/hood/fitness.clj
  2. +39 −0 test/hood/fitness_test.clj
View
26 src/hood/fitness.clj
@@ -0,0 +1,26 @@
+(ns hood.fitness
+ [:require
+ [clojure.math.numeric-tower :refer [expt]]])
+
+(defn fitness
+ "The fitness of the given grant allocation"
+ [score prob allocations]
+ (reduce (fn [acc [app grant]]
+ (+ acc
+ (* (score app)
+ (prob app grant))))
+ 0 allocations))
+
+(defn lin-p
+ "A probability function that assumes that the probability someone
+ attends is equal to the ratio of the grant money that they wanted
+ that they actually received."
+ [application granted]
+ (/ granted (:requested application)))
+
+(defn exp-p
+ [n application granted]
+ (expt (lin-p application granted) n))
+
+(def quad-p (partial exp-p 2))
+(def sqrt-p (partial exp-p 0.5))
View
39 test/hood/fitness_test.clj
@@ -0,0 +1,39 @@
+(ns hood.fitness-test
+ (:require [hood.fitness :refer :all]
+ [clojure.test :refer :all]))
+
+(defn application
+ [name score requested]
+ {:name name :score score :requested requested})
+
+(def one (application "One" 1 100))
+(def two (application "Two" 1 100))
+(def three (application "Three" 1 100))
+(def four (application "Four" 1 100))
+(def five (application "Five" 1 100))
+
+(def unequal-allocation {one 100
+ two 100
+ three 100
+ four 100
+ five 0})
+
+(def equal-allocation {one 80
+ two 80
+ three 80
+ four 80
+ five 80})
+
+(deftest several-identical-applications-test
+ (testing "lin-p considers both allocations equal"
+ (is (let [fit #(fitness :score lin-p %)]
+ (= (fit unequal-allocation)
+ (fit equal-allocation)))))
+ (testing "quad-p prefers unequal allocation"
+ (is (let [fit #(fitness :score quad-p %)]
+ (> (fit unequal-allocation)
+ (fit equal-allocation)))))
+ (testing "sqrt-p prefers equal allocation"
+ (is (let [fit #(fitness :score sqrt-p %)]
+ (< (fit unequal-allocation)
+ (fit equal-allocation))))))

0 comments on commit c523e3c

Please sign in to comment.
Something went wrong with that request. Please try again.