Provide more modular and and extensible approach to genetic operator dispatch

This commit is contained in:
Lee Spector 2020-12-08 22:53:37 -05:00
parent d49f9e4bf0
commit 180a7fdbe0
3 changed files with 82 additions and 29 deletions

View File

@ -26,10 +26,10 @@
(vec (concat (for [i (range num-inputs)] (keyword (str "in" i))) (vec (concat (for [i (range num-inputs)] (keyword (str "in" i)))
(take num-inputs (take num-inputs
(cycle [:boolean_xor (cycle [:boolean_xor
;:boolean_or :boolean_or
;:boolean_not :boolean_not
;:exec_if :exec_if
;'close 'close
]))))) ])))))
(defn error-function (defn error-function

View File

@ -190,21 +190,38 @@
;;; below is when I switched to just xor ;;; below is when I switched to just xor
;(gp/gp {:instructions propeller.problems.valiant/instructions
; :error-function propeller.problems.valiant/error-function
; :max-generations 500
; :population-size 500
; :max-initial-plushy-size 50
; :step-limit 2000
; :parent-selection :lexicase
; :tournament-size 2
; :umad-rate 0.01
; :diploid-flip-rate 0.01
; :variation {:umad 0.5
; :crossover 0.25
; :diploid-flip 0.25
; }
; :elitism false
; :diploid true})
;; separated diploid from other operators
(gp/gp {:instructions propeller.problems.valiant/instructions (gp/gp {:instructions propeller.problems.valiant/instructions
:error-function propeller.problems.valiant/error-function :error-function propeller.problems.valiant/error-function
:max-generations 500 :max-generations 500
:population-size 500 :population-size 50
:max-initial-plushy-size 50 :max-initial-plushy-size 50
:step-limit 2000 :step-limit 2000
:parent-selection :lexicase :parent-selection :lexicase
:tournament-size 2 :tournament-size 2
:umad-rate 0.01 :umad-rate 0.01
:diploid-flip-rate 0.01 :diploid-flip-rate 0.01
:variation {:umad 0.5 :variation {:diploid-umad 0.5
:crossover 0.25 :diploid-crossover 0.25
:diploid-flip 0.25 :diploid-flip 0.25
} }
:elitism false :elitism false
:diploid true}) :diploid true})

View File

@ -80,26 +80,62 @@
individuals in the population." individuals in the population."
[pop argmap] [pop argmap]
{:plushy {:plushy
(let [prob (rand) (let [r (rand)
[xover add del] (if (:diploid argmap) op (loop [accum 0.0
[diploid-crossover diploid-uniform-addition diploid-uniform-deletion] ops-probs (vec (:variation argmap))]
[crossover uniform-addition uniform-deletion]) (if (empty? ops-probs)
xover-prob (or (:crossover (:variation argmap)) 0) :reproduction
umad-prob (or (:umad (:variation argmap)) 0) (let [[op1 prob1] (first ops-probs)]
flip-prob (or (:diploid-flip (:variation argmap)) 0)] (if (>= (+ accum prob1) r)
(cond op1
(< prob xover-prob) (recur (+ accum prob1)
(xover (:plushy (selection/select-parent pop argmap)) (rest ops-probs))))))]
(case op
:crossover
(crossover
(:plushy (selection/select-parent pop argmap))
(:plushy (selection/select-parent pop argmap))) (:plushy (selection/select-parent pop argmap)))
; ;
(< prob (+ xover-prob umad-prob)) :umad
(del (add (:plushy (selection/select-parent pop argmap)) (-> (:plushy (selection/select-parent pop argmap))
(:instructions argmap) (uniform-addition (:instructions argmap) (:umad-rate argmap))
(:umad-rate argmap)) (uniform-deletion (:umad-rate argmap)))
(:umad-rate argmap))
; ;
(< prob (+ xover-prob umad-prob flip-prob)) :uniform-addition
(diploid-flip (:plushy (selection/select-parent pop argmap)) (-> (:plushy (selection/select-parent pop argmap))
(:diploid-flip-rate argmap)) (uniform-addition (:instructions argmap) (:umad-rate argmap)))
; ;
:else (:plushy (selection/select-parent pop argmap))))}) :uniform-deletion
(-> (:plushy (selection/select-parent pop argmap))
(uniform-deletion (:umad-rate argmap)))
;
:diploid-crossover
(diploid-crossover
(:plushy (selection/select-parent pop argmap))
(:plushy (selection/select-parent pop argmap)))
;
:diploid-umad
(-> (:plushy (selection/select-parent pop argmap))
(diploid-uniform-addition (:instructions argmap) (:umad-rate argmap))
(diploid-uniform-deletion (:umad-rate argmap)))
;
:diploid-uniform-addition
(-> (:plushy (selection/select-parent pop argmap))
(diploid-uniform-addition (:instructions argmap) (:umad-rate argmap)))
;
:diploid-uniform-deletion
(-> (:plushy (selection/select-parent pop argmap))
(diploid-uniform-deletion (:umad-rate argmap)))
;
:diploid-flip
(-> (:plushy (selection/select-parent pop argmap))
(diploid-flip (:diploid-flip-rate argmap)))
;
:reproduction
(:plushy (selection/select-parent pop argmap))
;
:else
(throw #?(:clj (Exception. (str "No match in new-individual for " op))
:cljs (js/Error
(str "No match in new-individual for " op))))))})