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

Undo deletion rate adjustment (done elsewhere), remove argmap arguments to genetic operators, define diploid genetic operators

Browse Source
This commit is contained in:
Lee Spector 2020-11-22 21:18:30 -05:00
parent 55644a9b6d
commit 67fcdb13b5
1 changed files with 39 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
src/propeller/variation.cljc
View File

@ -4,7 +4,7 @@
(defn crossover
"Crosses over two individuals using uniform crossover. Pads shorter one."
[plushy-a plushy-b argmap]
[plushy-a plushy-b]
(let [shorter (min-key count plushy-a plushy-b)
longer (if (= shorter plushy-a)
plushy-b
@ -16,23 +16,56 @@
shorter-padded
longer))))
(defn diploid-crossover
"Crosses over two individuals using uniform crossover. Pads shorter one."
[plushy-a plushy-b argmap]
(let [plushy-a (partition 2 plushy-a)
plushy-b (partition 2 plushy-b)
shorter (min-key count plushy-a plushy-b)
longer (if (= shorter plushy-a)
plushy-b
plushy-a)
length-diff (- (count longer) (count shorter))
shorter-padded (concat shorter (repeat length-diff :crossover-padding))]
(flatten (remove #(= % :crossover-padding)
(map #(if (< (rand) 0.5) %1 %2)
shorter-padded
longer)))))
(defn uniform-addition
"Returns plushy with new instructions possibly added before or after each
existing instruction."
[plushy instructions umad-rate argmap]
[plushy instructions umad-rate]
(apply concat
(map #(if (< (rand) umad-rate)
(shuffle [% (utils/random-instruction instructions)])
[%])
plushy)))
(defn diploid-uniform-addition
"Returns plushy with new instructions possibly added before or after each
existing instruction."
[plushy instructions umad-rate]
(flatten
(map #(if (< (rand) umad-rate)
(shuffle [% (repeatedly 2 #(utils/random-instruction instructions))])
[%])
(partition 2 plushy))))
(defn uniform-deletion
"Randomly deletes instructions from plushy at some rate."
[plushy umad-rate argmap]
[plushy umad-rate]
(remove (fn [_] (< (rand)
(/ 1 (+ 1 (/ 1 umad-rate)))))
plushy))
(defn diploid-uniform-deletion
"Randomly deletes instructions from plushy at some rate."
[plushy umad-rate]
(flatten (remove (fn [_] (< (rand)
(/ 1 (+ 1 (/ 1 umad-rate)))))
(partition 2 plushy))))
(defn new-individual
"Returns a new individual produced by selection and variation of
individuals in the population."
@ -42,14 +75,11 @@
(cond
(< prob (:crossover (:variation argmap)))
(crossover (:plushy (selection/select-parent pop argmap))
(:plushy (selection/select-parent pop argmap))
argmap)
(:plushy (selection/select-parent pop argmap)))
(< prob (+ (:crossover (:variation argmap))
(:umad (:variation argmap))))
(uniform-deletion (uniform-addition (:plushy (selection/select-parent pop argmap))
(:instructions argmap)
(:umad-rate argmap)
argmap)
(/ 1 (+ (/ 1 (:umad-rate argmap)) 1))
argmap)
(:umad-rate argmap))
(:umad-rate argmap))
:else (:plushy (selection/select-parent pop argmap))))})