From 06e9f9445d5c9ab1e86926d9c42e69a542c9f501 Mon Sep 17 00:00:00 2001
From: Lee Spector <lspector@hampshire.edu>
Date: Sat, 2 Sep 2023 16:38:15 -0400
Subject: [PATCH] Add motley batch lexicase selection

---
 src/propeller/problems/boolean/mul3.cljc |  7 ++++--
 src/propeller/selection.cljc             | 28 ++++++++++++++++++++++--
 2 files changed, 31 insertions(+), 4 deletions(-)

diff --git a/src/propeller/problems/boolean/mul3.cljc b/src/propeller/problems/boolean/mul3.cljc
index ecb6a73..c2ee561 100644
--- a/src/propeller/problems/boolean/mul3.cljc
+++ b/src/propeller/problems/boolean/mul3.cljc
@@ -306,8 +306,10 @@
      :population-size          1000
      :max-initial-plushy-size  100
      :step-limit               1000
-     :parent-selection         :lexicase
+     ;:parent-selection         :lexicase
      ;:parent-selection         :tournament
+     :parent-selection         :motley-batch-lexicase
+     :max-batch-size           16
      :tournament-size          5
      :umad-rate                0.05
      :alternation-rate         0.05
@@ -323,5 +325,6 @@
      ;                           :diploid-flip 0.1}
      ;:replacement-rate         0.01
      ;:diploid-flip-rate        0.01
-     :elitism                  false}
+     :elitism                  false
+     :single-thread-mode       false}
     (apply hash-map (map #(if (string? %) (read-string %) %) args)))))
diff --git a/src/propeller/selection.cljc b/src/propeller/selection.cljc
index 3d5b4af..058f908 100755
--- a/src/propeller/selection.cljc
+++ b/src/propeller/selection.cljc
@@ -29,6 +29,29 @@
                        survivors)
                (rest cases))))))
 
+(defn motley-batch-lexicase-selection
+  "Selects an individual from the population using motley batch lexicase selection.
+   Cases are combined in random collections of max size (:max-batch-size argmap),
+   and then the population is passed to lexicase-selection."
+  [pop argmap]
+  (let [cases (range (count (:errors (first pop))))
+        batches (loop [remaining (shuffle cases)
+                       result ()]
+                  (if (empty? remaining)
+                    result
+                    (let [n (inc (rand-int (:max-batch-size argmap)))]
+                      (recur (drop n remaining)
+                             (conj result (take n remaining))))))]
+    (lexicase-selection (mapv (fn [ind]
+                                (assoc ind
+                                       :errors
+                                       (mapv (fn [batch]
+                                               (reduce + (map #(nth (:errors ind) %)
+                                                              batch)))
+                                             batches)))
+                              pop)
+                        argmap)))
+
 (defn epsilon-list
   "List of epsilons for each training case based on median absolute deviation of errors."
   [pop]
@@ -39,7 +62,7 @@
         epsilons
         (recur (conj epsilons
                      (math-tools/median-absolute-deviation
-                       (map #(nth % i) error-list)))
+                      (map #(nth % i) error-list)))
                (inc i))))))
 
 (defn epsilon-lexicase-selection
@@ -69,4 +92,5 @@
   (case (:parent-selection argmap)
     :tournament (tournament-selection pop argmap)
     :lexicase (lexicase-selection pop argmap)
-    :epsilon-lexicase (epsilon-lexicase-selection pop argmap)))
+    :epsilon-lexicase (epsilon-lexicase-selection pop argmap)
+    :motley-batch-lexicase (motley-batch-lexicase-selection pop argmap)))