Rework bmx-umad gap addition and deletion

This commit is contained in:
Lee Spector 2023-12-07 18:32:11 -05:00
parent 82657abf32
commit 9fa35c4562

View File

@ -138,22 +138,32 @@ The function `new-individual` returns a new individual produced by selection and
(< (rand) adjusted-rate))) (< (rand) adjusted-rate)))
plushy)))) plushy))))
(defn uniform-gap-deletion (defn uniform-gap-addition
"Randomly deletes instances of :gap from plushy at some rate, which has to be adjusted not "Returns plushy with new instances of :gap possibly added within each gene,
only because additions may already have happened, but also because while :gap can be added each of which is a subsequence of the plushy."
anywhere, it can only be deleted where it already is." [plushy gap-change-prob]
[plushy gap-change-rate] (if (zero? gap-change-prob)
(let [gap-count (count (filter #(= % :gap) plushy))]
(if (or (zero? gap-change-rate)
(empty? plushy)
(zero? gap-count))
plushy plushy
(let [adjusted-rate (/ 1 (/ (+ 1 (/ 1 gap-change-rate)) (flatten (interpose :gap
(/ (count plushy) gap-count)))] (apply concat
(mapv (fn [gene]
(if (< (rand) gap-change-prob)
(let [n (rand-int (inc (count gene)))]
[(take n gene) (drop n gene)])
[gene]))
(utils/extract-genes plushy)))))))
(defn uniform-gap-deletion
"Randomly deletes instances of :gap from plushy at a rate that is adjusted
relative to the rate used for gap addition."
[plushy gap-change-prob]
(if (zero? gap-change-prob)
plushy
(let [adjusted-rate (/ 1 (+ 1 (/ 1 gap-change-prob)))]
(remove (fn [item] (remove (fn [item]
(and (= item :gap) (and (= item :gap)
(< (rand) adjusted-rate))) (< (rand) adjusted-rate)))
plushy))))) plushy))))
(defn bmx (defn bmx
"Crosses over two plushies using best match crossover (bmx)." "Crosses over two plushies using best match crossover (bmx)."
@ -215,11 +225,11 @@ The function `new-individual` returns a new individual produced by selection and
(uniform-deletion rate))) (uniform-deletion rate)))
; ;
:bmx-umad ;; applies umad to the results of bmx :bmx-umad ;; applies umad to the results of bmx
(let [umad-rate (utils/onenum (:umad-rate argmap))] (let [umad-rate (utils/onenum (:umad-rate argmap))
gap-change-prob (utils/onenum (:bmx-gap-change-probability argmap))]
(-> (let [parent1 (selection/select-parent pop argmap) (-> (let [parent1 (selection/select-parent pop argmap)
parent2 (if (:bmx-complementary? argmap) parent2 (if (:bmx-complementary? argmap)
(selection/select-parent (selection/select-parent pop
pop
(assoc argmap (assoc argmap
:initial-cases :initial-cases
(reverse (:selection-cases parent1)))) (reverse (:selection-cases parent1))))
@ -228,8 +238,10 @@ The function `new-individual` returns a new individual produced by selection and
plushy2 (:plushy parent2) plushy2 (:plushy parent2)
bmx-exchange-rate (utils/onenum (or (:bmx-exchange-rate argmap) 0.5))] bmx-exchange-rate (utils/onenum (or (:bmx-exchange-rate argmap) 0.5))]
(bmx plushy1 plushy2 bmx-exchange-rate)) (bmx plushy1 plushy2 bmx-exchange-rate))
(uniform-addition [:gap] (:bmx-gap-change-probability argmap)) (uniform-gap-addition gap-change-prob)
(uniform-gap-deletion (:bmx-gap-change-probability argmap)))) (uniform-gap-deletion gap-change-prob)
(uniform-addition (:instructions argmap) umad-rate)
(uniform-deletion umad-rate)))
; ;
:rumad ;; responsive UMAD, uses a deletion rate computed from the actual :rumad ;; responsive UMAD, uses a deletion rate computed from the actual
;; number of additions made ;; number of additions made