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-addition
"Returns plushy with new instances of :gap possibly added within each gene,
each of which is a subsequence of the plushy."
[plushy gap-change-prob]
(if (zero? gap-change-prob)
plushy
(flatten (interpose :gap
(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 (defn uniform-gap-deletion
"Randomly deletes instances of :gap from plushy at some rate, which has to be adjusted not "Randomly deletes instances of :gap from plushy at a rate that is adjusted
only because additions may already have happened, but also because while :gap can be added relative to the rate used for gap addition."
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))] plushy
(if (or (zero? gap-change-rate) (let [adjusted-rate (/ 1 (+ 1 (/ 1 gap-change-prob)))]
(empty? plushy) (remove (fn [item]
(zero? gap-count)) (and (= item :gap)
plushy (< (rand) adjusted-rate)))
(let [adjusted-rate (/ 1 (/ (+ 1 (/ 1 gap-change-rate)) plushy))))
(/ (count plushy) gap-count)))]
(remove (fn [item]
(and (= item :gap)
(< (rand) adjusted-rate)))
plushy)))))
(defn bmx (defn bmx
"Crosses over two plushies using best match crossover (bmx)." "Crosses over two plushies using best match crossover (bmx)."
@ -215,21 +225,23 @@ 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))))
(selection/select-parent pop argmap)) (selection/select-parent pop argmap))
plushy1 (:plushy parent1) plushy1 (:plushy parent1)
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