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

Correctly handle leadin/trailing :gene

Browse Source
This commit is contained in:
Lee Spector 2023-11-03 12:30:14 -04:00
parent c0bc7bc191
commit 5fd533c24f
1 changed files with 25 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
src/propeller/variation.cljc
View File

@ -279,15 +279,33 @@ The function `new-individual` returns a new individual produced by selection and
plushy plushy
(ah-rates plushy ah-min ah-max ah-mean))))) (ah-rates plushy ah-min ah-max ah-mean)))))
(defn count-genes
"Returns the number of segments between (and before and after) instances of :gene."
[plushy]
(inc (count (filter #(= % :gene) plushy))))
(defn extract-genes (defn extract-genes
[plushy] [plushy]
(apply concat (loop [genes []
(mapv #(if (some #{:gene} %) current-gene []
(repeat (dec (count %)) ()) remainder plushy]
[%]) (cond (empty? remainder)
(partition-by #(= % :gene) plushy)))) (conj genes current-gene)
;
(= (first remainder) :gene)
(recur (conj genes current-gene)
[]
(rest remainder))
;
:else
(recur genes
(conj current-gene (first remainder))
(rest remainder)))))
#_(extract-genes [:add :x :y :gene :z :gene :gene :gene :w :gene]) #_(extract-genes [:add :x :y :gene :z :gene :gene :gene :w :gene])
#_(extract-genes [:gene :z :gene :gene :gene :w :gene])
#_(extract-genes [:gene])
#_(extract-genes [])
(defn autoconstructive-crossover (defn autoconstructive-crossover
"Crosses over two plushies using autoconstructive crossover, one Push instruction at a time. "Crosses over two plushies using autoconstructive crossover, one Push instruction at a time.
@ -333,9 +351,9 @@ The function `new-individual` returns a new individual produced by selection and
; ;
:autoconstructive-crossover :autoconstructive-crossover
(let [plushy1 (:plushy (selection/select-parent pop argmap)) (let [plushy1 (:plushy (selection/select-parent pop argmap))
p1-genes (count (extract-genes plushy1)) p1-genes (count-genes plushy1)
plushy2 (:plushy (selection/select-parent plushy2 (:plushy (selection/select-parent
(filter #(= (count (extract-genes (:plushy %))) (filter #(= (count-genes (:plushy %))
p1-genes) p1-genes)
pop) pop)
argmap))] argmap))]