Select mates with same number of genes in autoconstructive crossover

This commit is contained in:
Lee Spector 2023-11-02 23:16:10 -04:00
parent ac3690837d
commit c0bc7bc191
2 changed files with 30 additions and 17 deletions

View File

@ -314,7 +314,7 @@
;:parent-selection :motley-batch-lexicase ;:parent-selection :motley-batch-lexicase
;:max-batch-size [1 2 4 8 16 32 64 128 256] ;:max-batch-size [1 2 4 8 16 32 64 128 256]
;:tournament-size 5 ;:tournament-size 5
:umad-rate 0.09 :umad-rate 0.01
;:ah-umad-min 0.01 ;:ah-umad-min 0.01
;:ah-umad-max 0.5 ;:ah-umad-max 0.5
;:ah-umad-mean 0.05 ;:ah-umad-mean 0.05

View File

@ -279,21 +279,29 @@ 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 extract-genes
[plushy]
(apply concat
(mapv #(if (some #{:gene} %)
(repeat (dec (count %)) ())
[%])
(partition-by #(= % :gene) plushy))))
#_(extract-genes [:add :x :y :gene :z :gene :gene :gene :w :gene])
(defn autoconstructive-crossover (defn autoconstructive-crossover
"Crosses over two individuals using autoconstructive crossover, one Push instruction at a time. "Crosses over two plushies using autoconstructive crossover, one Push instruction at a time.
Pads shorter one from the end of the list of instructions." Assumes the plushies have the same number of genes."
[plushy-a plushy-b] [plushy-a plushy-b]
(let [a-genes (partition-by #(= % :gene) plushy-a) (let [a-genes (extract-genes plushy-a)
b-genes (partition-by #(= % :gene) plushy-b) b-genes (extract-genes plushy-b)]
shorter (min-key count a-genes b-genes) (flatten (interpose :gene
longer (if (= shorter a-genes) (mapv #(if (< (rand) 0.5) %1 %2)
b-genes a-genes
a-genes) b-genes)))))
length-diff (- (count longer) (count shorter))
shorter-padded (concat shorter (repeat length-diff ()))] #_(autoconstructive-crossover [:add :x :y :gene :z :gene :gene :gene :w :gene]
(flatten (mapv #(if (< (rand) 0.5) %1 %2) [1 :gene 2 3 :gene 4 :gene 5 :gene :gene])
shorter-padded
longer))))
(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
@ -324,9 +332,14 @@ The function `new-individual` returns a new individual produced by selection and
(:plushy (selection/select-parent pop argmap))) (:plushy (selection/select-parent pop argmap)))
; ;
:autoconstructive-crossover :autoconstructive-crossover
(autoconstructive-crossover (let [plushy1 (:plushy (selection/select-parent pop argmap))
(:plushy (selection/select-parent pop argmap)) p1-genes (count (extract-genes plushy1))
(:plushy (selection/select-parent pop argmap))) plushy2 (:plushy (selection/select-parent
(filter #(= (count (extract-genes (:plushy %)))
p1-genes)
pop)
argmap))]
(autoconstructive-crossover plushy1 plushy2))
; ;
:umad :umad
(let [rate (utils/onenum (:umad-rate argmap))] (let [rate (utils/onenum (:umad-rate argmap))]