Add bmx-rate

This commit is contained in:
Lee Spector 2023-11-20 20:48:06 -05:00
parent d81a9ae3b6
commit 5ce452b6ff
2 changed files with 10 additions and 9 deletions

View File

@ -314,5 +314,6 @@
:umad 0 :umad 0
:bmx 0.1} :bmx 0.1}
:single-thread-mode false :single-thread-mode false
:bmx-rate 0.1
:bmx-enrichment 10} :bmx-enrichment 10}
(apply hash-map (map #(if (string? %) (read-string %) %) args))))) (apply hash-map (map #(if (string? %) (read-string %) %) args)))))

View File

@ -214,13 +214,13 @@ The function `new-individual` returns a new individual produced by selection and
(ah-rates plushy ah-min ah-max ah-mean))))) (ah-rates plushy ah-min ah-max ah-mean)))))
(defn count-genes (defn count-genes
"A utility for autoconstructive crossover. Returns the number of segments "A utility for best match crossover (bmx). Returns the number of segments
between (and before and after) instances of :gene." between (and before and after) instances of :gene."
[plushy] [plushy]
(inc (count (filter #(= % :gene) plushy)))) (inc (count (filter #(= % :gene) plushy))))
(defn extract-genes (defn extract-genes
"A utility for autoconstructive crossover. Returns the segments of the plushy "A utility for best match crossover (bmx). Returns the segments of the plushy
before/between/after instances of :gene." before/between/after instances of :gene."
[plushy] [plushy]
(loop [genes [] (loop [genes []
@ -240,15 +240,15 @@ The function `new-individual` returns a new individual produced by selection and
(rest remainder))))) (rest remainder)))))
(defn bmx (defn bmx
"Crosses over two plushies using autoconstructive crossover, one Push instruction at a time." "Crosses over two plushies using best match crossover (bmx)."
[plushy-a plushy-b] [plushy-a plushy-b rate]
(let [a-genes (extract-genes plushy-a) (let [a-genes (extract-genes plushy-a)
b-genes (extract-genes plushy-b)] b-genes (extract-genes plushy-b)]
(flatten (interpose :gene (flatten (interpose :gene
(mapv (fn [g] (mapv (fn [g]
(if (< (rand) 0.5) (if (< (rand) rate)
g (apply min-key #(metrics/levenshtein-distance g %) b-genes)
(apply min-key #(metrics/levenshtein-distance g %) b-genes))) g))
a-genes))))) a-genes)))))
(defn new-individual (defn new-individual
@ -280,7 +280,7 @@ The function `new-individual` returns a new individual produced by selection and
:bmx :bmx
(let [plushy1 (:plushy (selection/select-parent pop argmap)) (let [plushy1 (:plushy (selection/select-parent pop argmap))
plushy2 (:plushy (selection/select-parent pop argmap))] plushy2 (:plushy (selection/select-parent pop argmap))]
(bmx plushy1 plushy2)) (bmx plushy1 plushy2 (or (:bmx-rate argmap) 0.5)))
; ;
:umad ;; uniform mutation by addition and deleted, see uniform-deletion for the :umad ;; uniform mutation by addition and deleted, see uniform-deletion for the
;; adjustment that makes this size neutral on average ;; adjustment that makes this size neutral on average