Report on :best-gene-count and :average-gene-count in bmx; move gene …

…utilities to utils
lspector · Nov 21, 2023 · c61934e · c61934e
1 parent 5ce452b
commit c61934e
Show file tree

Hide file tree

Showing 3 changed files with 48 additions and 42 deletions.
diff --git a/src/propeller/gp.cljc b/src/propeller/gp.cljc
@@ -21,20 +21,26 @@
   [evaluations pop generation argmap training-data]
   (let [best (first pop)]
     (utils/pretty-map-println
-     {:generation            generation
-      :best-plushy           (:plushy best)
-      :best-program          (genome/plushy->push (:plushy best) argmap)
-      :best-total-error      (:total-error best)
-      :evaluations           evaluations
-      :ds-indices            (if (:downsample? argmap)
-                              (map #(:index %) training-data)
-                               nil)
-      :best-errors           (:errors best)
-      :best-behaviors        (:behaviors best)
-      :genotypic-diversity   (float (/ (count (distinct (map :plushy pop))) (count pop)))
-      :behavioral-diversity  (float (/ (count (distinct (map :behaviors pop))) (count pop)))
-      :average-genome-length (float (/ (reduce + (map count (map :plushy pop))) (count pop)))
-      :average-total-error   (float (/ (reduce + (map :total-error pop)) (count pop)))})))
+     (merge
+      {:generation            generation
+       :best-plushy           (:plushy best)
+       :best-program          (genome/plushy->push (:plushy best) argmap)
+       :best-total-error      (:total-error best)
+       :evaluations           evaluations
+       :ds-indices            (if (:downsample? argmap)
+                                (map #(:index %) training-data)
+                                nil)
+       :best-errors           (:errors best)
+       :best-behaviors        (:behaviors best)
+       :genotypic-diversity   (float (/ (count (distinct (map :plushy pop))) (count pop)))
+       :behavioral-diversity  (float (/ (count (distinct (map :behaviors pop))) (count pop)))
+       :average-genome-length (float (/ (reduce + (map count (map :plushy pop))) (count pop)))
+       :average-total-error   (float (/ (reduce + (map :total-error pop)) (count pop)))}
+      (if (> (or (:bmx (:variation argmap)) 0) 0) ; using bmx
+        {:best-gene-count     (utils/count-genes (:plushy best))
+         :average-gene-count  (float (/ (reduce + (map utils/count-genes (map :plushy pop)))
+                                        (count pop)))}
+        {})))))
 
 (defn cleanup
   []

diff --git a/src/propeller/utils.cljc b/src/propeller/utils.cljc
@@ -162,3 +162,29 @@
     (doseq [[k v] (rest mp-seq)]
       (println (str " " (pr-str k v)))))
   (println "}"))
+
+(defn count-genes
+  "A utility for best match crossover (bmx). Returns the number of segments 
+   between (and before and after) instances of :gene."
+  [plushy]
+  (inc (count (filter #(= % :gene) plushy))))
+
+(defn extract-genes
+  "A utility for best match crossover (bmx). Returns the segments of the plushy
+   before/between/after instances of :gene."
+  [plushy]
+  (loop [genes []
+         current-gene []
+         remainder plushy]
+    (cond (empty? remainder)
+          (conj genes current-gene)
+          ;
+          (= (first remainder) :gene)
+          (recur (conj genes current-gene)
+                 []
+                 (rest remainder))
+          ;
+          :else
+          (recur genes
+                 (conj current-gene (first remainder))
+                 (rest remainder)))))
diff --git a/src/propeller/variation.cljc b/src/propeller/variation.cljc
@@ -213,37 +213,11 @@ The function `new-individual` returns a new individual produced by selection and
                       plushy
                       (ah-rates plushy ah-min ah-max ah-mean)))))
 
-(defn count-genes
-  "A utility for best match crossover (bmx). Returns the number of segments 
-   between (and before and after) instances of :gene."
-  [plushy]
-  (inc (count (filter #(= % :gene) plushy))))
-
-(defn extract-genes
-  "A utility for best match crossover (bmx). Returns the segments of the plushy
-   before/between/after instances of :gene."
-  [plushy]
-  (loop [genes []
-         current-gene []
-         remainder plushy]
-    (cond (empty? remainder)
-          (conj genes current-gene)
-          ;
-          (= (first remainder) :gene)
-          (recur (conj genes current-gene)
-                 []
-                 (rest remainder))
-          ;
-          :else
-          (recur genes
-                 (conj current-gene (first remainder))
-                 (rest remainder)))))
-
 (defn bmx
   "Crosses over two plushies using best match crossover (bmx)."
   [plushy-a plushy-b rate]
-  (let [a-genes (extract-genes plushy-a)
-        b-genes (extract-genes plushy-b)]
+  (let [a-genes (utils/extract-genes plushy-a)
+        b-genes (utils/extract-genes plushy-b)]
     (flatten (interpose :gene
                         (mapv (fn [g]
                                 (if (< (rand) rate)