diff --git a/src/propeller/gp.cljc b/src/propeller/gp.cljc index 72ec5af..9df6d01 100644 --- a/src/propeller/gp.cljc +++ b/src/propeller/gp.cljc @@ -11,7 +11,8 @@ [propeller.push.instructions.numeric] [propeller.push.instructions.polymorphic] [propeller.push.instructions.string] - [propeller.push.instructions.vector])) + [propeller.push.instructions.vector] + [propeller.selection :as selection])) (defn report "Reports information each generation." @@ -50,7 +51,10 @@ (mapper (partial error-function argmap (:training-data argmap)) population)) - best-individual (first evaluated-pop)] + best-individual (first evaluated-pop) + argmap (if (= (:parent-selection argmap) :epsilon-lexicase) + (assoc argmap :epsilons (selection/epsilon-list evaluated-pop)) + argmap)] (if (:custom-report argmap) ((:custom-report argmap) evaluated-pop generation argmap) (report evaluated-pop generation argmap)) diff --git a/src/propeller/selection.cljc b/src/propeller/selection.cljc index 487ecf2..f6b2932 100755 --- a/src/propeller/selection.cljc +++ b/src/propeller/selection.cljc @@ -1,4 +1,5 @@ -(ns propeller.selection) +(ns propeller.selection + (:require [propeller.tools.math :as math-tools])) (defn tournament-selection "Selects an individual from the population using a tournament." @@ -21,9 +22,37 @@ survivors) (rest cases)))))) +(defn epsilon-list + [pop] + (let [error-list (map :errors pop) + length (count (:errors (first pop)))] + (loop [epsilons [] i 0] + (if (= i length) + epsilons + (recur (conj epsilons (math-tools/median-absolute-deviation (map #(nth % i) error-list))) (inc i)))))) + +(defn epsilon-lexicase-selection + "Selects an individual from the population using epsilon-lexicase selection." + [pop argmap] + (let [epsilons (:epsilons argmap)] + (loop [survivors pop + cases (shuffle (range (count (:errors (first pop)))))] + (if (or (empty? cases) + (empty? (rest survivors))) + (rand-nth survivors) + + (let [min-err-for-case (apply min (map #(nth % (first cases)) + (map :errors survivors))) + epsilon (nth epsilons (first cases))] + + (recur (filter #(<= (Math/abs (- (nth (:errors %) (first cases)) min-err-for-case)) epsilon) + survivors) + (rest cases))))))) + (defn select-parent "Selects a parent from the population using the specified method." [pop argmap] (case (:parent-selection argmap) :tournament (tournament-selection pop argmap) - :lexicase (lexicase-selection pop argmap))) + :lexicase (lexicase-selection pop argmap) + :epsilon-lexicase (epsilon-lexicase-selection pop argmap))) diff --git a/src/propeller/tools/math.cljc b/src/propeller/tools/math.cljc index 03ed549..574dd18 100755 --- a/src/propeller/tools/math.cljc +++ b/src/propeller/tools/math.cljc @@ -6,6 +6,29 @@ (defonce E #?(:clj Math/E :cljs js/Math.PI)) +(defn mean [coll] + (let [sum (apply + coll) + count (count coll)] + (if (pos? count) + (/ sum (float count)) + 0))) + +(defn median [coll] + (let [sorted (sort coll) + cnt (count sorted) + halfway (quot cnt 2.0)] + (if (odd? cnt) + (nth sorted halfway) + (let [bottom (dec halfway) + bottom-val (nth sorted bottom) + top-val (nth sorted halfway)] + (mean [bottom-val top-val]))))) + +(defn median-absolute-deviation + [coll] + (let [median-val (median coll)] + (median (map #(Math/abs (- % median-val)) coll)))) + (defn abs "Returns the absolute value of a number." [x] diff --git a/test/propeller/tools/math_test.cljc b/test/propeller/tools/math_test.cljc index c189536..541fb9a 100644 --- a/test/propeller/tools/math_test.cljc +++ b/test/propeller/tools/math_test.cljc @@ -60,4 +60,16 @@ (t/is (m/approx= (m/tan (/ m/PI 4)) 1.0 0.00001)) (t/is (= (m/tan 0) 0.0))) +(t/deftest mean-test + (t/is (= (m/mean []) 0.0)) + (t/is (= (m/mean [1 2 3 4 5]) 3.0)) + (t/is (= (m/mean '(6 7 8 9 10)) 8.0) 8.0)) + +(t/deftest median-test + (t/is (= (m/median [1 2 3 4 5]) 3)) + (t/is (= (m/median '(1 2 3 4 5 6)) 3.5))) + +(t/deftest median-absolute-deviation-test + (t/is (= (m/median-absolute-deviation [1 2 3 4 5]) 1)) + (t/is (= (m/median-absolute-deviation '(1 2 3 4 5 6)) 1.5)))