From c61934e50bed21658d7270063aa191f7097a3b14 Mon Sep 17 00:00:00 2001 From: Lee Spector Date: Mon, 20 Nov 2023 21:09:06 -0500 Subject: [PATCH] Report on :best-gene-count and :average-gene-count in bmx; move gene utilities to utils --- src/propeller/gp.cljc | 34 ++++++++++++++++++++-------------- src/propeller/utils.cljc | 26 ++++++++++++++++++++++++++ src/propeller/variation.cljc | 30 ++---------------------------- 3 files changed, 48 insertions(+), 42 deletions(-) diff --git a/src/propeller/gp.cljc b/src/propeller/gp.cljc index c593e9d..3fd72ed 100644 --- 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 index afc2faf..27aa193 100755 --- 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))))) \ No newline at end of file diff --git a/src/propeller/variation.cljc b/src/propeller/variation.cljc index eab7197..3ae50c8 100644 --- 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)