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

31
src/propeller/variation.cljc
View File

@ -173,28 +173,13 @@ 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]
@ -202,13 +187,13 @@ The function `new-individual` returns a new individual produced by selection and
:gene b-gene}) :gene b-gene})
b-genes) b-genes)
candidates (filter (fn [info] candidates (filter (fn [info]
(<= (:distance info) 3)) (<= (:distance info) max-distance))
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)