rowan.a.tl/propeller
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add argument for :bmx-maximum-distance; don't merge adjacent gaps

Browse Source
This commit is contained in:
Lee Spector 2023-12-11 15:30:55 -05:00
parent 3ce672c022
commit b2bcab59de
1 changed files with 21 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
src/propeller/variation.cljc
View File

@ -173,42 +173,27 @@ The function `new-individual` returns a new individual produced by selection and
(+ (* 0.5 (metrics/multiset-distance p1 p2)) (+ (* 0.5 (metrics/multiset-distance p1 p2))
(math/abs (- (count p1) (count p2))))) (math/abs (- (count p1) (count p2)))))
;; (defn bmx
;; "Crosses over two plushies using best match crossover (bmx)."
;; [plushy-a plushy-b rate]
;; (let [a-genes (utils/extract-genes plushy-a)
;; b-genes (utils/extract-genes plushy-b)]
;; (flatten
;; (interpose :gap
;; (remove empty?
;; (mapv (fn [g]
;; (if (< (rand) rate)
;; (apply min-key #(bmx-distance g %) b-genes)
;; g))
;; a-genes))))))
(defn bmx (defn bmx
"Crosses over two plushies using best match crossover (bmx)." "Crosses over two plushies using best match crossover (bmx)."
[plushy-a plushy-b rate] [plushy-a plushy-b rate max-distance]
(let [a-genes (utils/extract-genes plushy-a) (let [a-genes (utils/extract-genes plushy-a)
b-genes (utils/extract-genes plushy-b)] b-genes (utils/extract-genes plushy-b)]
(flatten (flatten
(interpose :gap (interpose :gap
(remove empty? (mapv (fn [a-gene]
(mapv (fn [a-gene] (if (< (rand) rate)
(if (< (rand) rate) (let [match-info (map (fn [b-gene]
(let [match-info (map (fn [b-gene] {:distance (bmx-distance a-gene b-gene)
{:distance (bmx-distance a-gene b-gene) :gene b-gene})
:gene b-gene}) b-genes)
b-genes) candidates (filter (fn [info]
candidates (filter (fn [info] (<= (:distance info) max-distance))
(<= (:distance info) 3)) match-info)]
match-info)] (if (empty? candidates)
(if (empty? candidates) a-gene
a-gene (:gene (apply min-key :distance candidates))))
(:gene (apply min-key :distance candidates)))) a-gene))
a-gene)) a-genes)))))
a-genes))))))
(defn new-individual (defn new-individual
"Returns a new individual produced by selection and variation of "Returns a new individual produced by selection and variation of
@ -248,8 +233,9 @@ The function `new-individual` returns a new individual produced by selection and
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))
gap-change-prob (utils/onenum (:bmx-gap-change-probability argmap))] gap-change-prob (utils/onenum (:bmx-gap-change-probability argmap))
(-> (bmx plushy1 plushy2 bmx-exchange-rate) max-distance (utils/onenum (:bmx-maximum-distance argmap))]
(-> (bmx plushy1 plushy2 bmx-exchange-rate max-distance)
(uniform-gap-addition gap-change-prob) (uniform-gap-addition gap-change-prob)
(uniform-gap-deletion gap-change-prob))) (uniform-gap-deletion gap-change-prob)))
; ;
@ -272,8 +258,9 @@ The function `new-individual` returns a new individual produced by selection and
(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)) max-distance (utils/onenum (:bmx-maximum-distance argmap))]
(bmx plushy1 plushy2 bmx-exchange-rate max-distance))
(uniform-gap-addition gap-change-prob) (uniform-gap-addition gap-change-prob)
(uniform-gap-deletion gap-change-prob) (uniform-gap-deletion gap-change-prob)
(uniform-addition (:instructions argmap) umad-rate) (uniform-addition (:instructions argmap) umad-rate)