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

Switch to normalized autoconstructive hypervariation; reformat

Browse Source
This commit is contained in:
Lee Spector 2023-10-18 17:05:38 -04:00
parent adf039195c
commit 37df3432fb
3 changed files with 156 additions and 165 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
src/propeller/gp.cljc
View File

@ -23,29 +23,18 @@
[evaluations pop generation argmap training-data] [evaluations pop generation argmap training-data]
(let [best (first pop)] (let [best (first pop)]
(clojure.pprint/pprint (clojure.pprint/pprint
(merge {:generation generation {:generation generation
:best-plushy (:plushy best) :best-plushy (:plushy best)
:best-program (genome/plushy->push (:plushy best) argmap) :best-program (genome/plushy->push (:plushy best) argmap)
:best-total-error (:total-error best) :best-total-error (:total-error best)
:evaluations evaluations :evaluations evaluations
:ds-indices (map #(:index %) training-data) :ds-indices (map #(:index %) training-data)
:best-errors (:errors best) :best-errors (:errors best)
:best-behaviors (:behaviors best) :best-behaviors (:behaviors best)
:genotypic-diversity (float (/ (count (distinct (map :plushy pop))) (count pop))) :genotypic-diversity (float (/ (count (distinct (map :plushy pop))) (count pop)))
:behavioral-diversity (float (/ (count (distinct (map :behaviors pop))) (count pop))) :behavioral-diversity (float (/ (count (distinct (map :behaviors pop))) (count pop)))
:average-genome-length (float (/ (reduce + (map count (map :plushy pop))) (count pop))) :average-genome-length (float (/ (reduce + (map count (map :plushy pop))) (count pop)))
:average-total-error (float (/ (reduce + (map :total-error pop)) (count pop)))} :average-total-error (float (/ (reduce + (map :total-error pop)) (count pop)))})
(if (> (or (:ah-umad (:variation argmap)) 0) 0) ;; using autoconstructive hypervariability
{:average-hypervariability
(let [variabilities (map (fn [i]
(let [p (:plushy i)]
(if (empty? p)
0
(/ (reduce + (variation/ah-rates p 0 1))
(count p)))))
pop)]
(float (/ (reduce + variabilities) (count variabilities))))}
{})))
(println))) (println)))
(defn gp (defn gp

11
src/propeller/problems/boolean/mul3.cljc
View File

@ -303,21 +303,20 @@
:training-data (:train train-and-test-data) :training-data (:train train-and-test-data)
:testing-data (:test train-and-test-data) :testing-data (:test train-and-test-data)
:max-generations 1000 :max-generations 1000
:population-size 100 :population-size 1000
:max-initial-plushy-size 100 :max-initial-plushy-size 100
:step-limit 1000 :step-limit 10000
:parent-selection :lexicase :parent-selection :lexicase
:downsample? true :downsample? true
:ds-function :case-rand :ds-function :case-rand
:downsample-rate 0.1 :downsample-rate 0.5
;:parent-selection :tournament ;:parent-selection :tournament
;: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.09
:ah-umad-protect-rate 0.001 ;; ah-umad :ah-umad-protection 10 ;; ah-umad
:ah-umad-vary-rate 0.1 ;; ah-umad :ah-umad-rate 0.1 ;; ah-umad
:ah-umad-tournament-size 1 ;; ah-umad
;:umad-rate [1/2 ;:umad-rate [1/2
; 1/4 1/4 ; 1/4 1/4
; 1/8 1/8 1/8 ; 1/8 1/8 1/8

261
src/propeller/variation.cljc
View File

@ -202,16 +202,24 @@ The function `new-individual` returns a new individual produced by selection and
%) %)
(partition 2 plushy)))) (partition 2 plushy))))
(defn with-mean
"Returns numeric vector v scaled so that the mean value is m"
[m v]
(if (empty? v)
v
(let [initial-mean (/ (reduce + v) (count v))]
(map #(* m (/ % initial-mean)) v))))
(defn ah-rates (defn ah-rates
"Returns the sequence of rates with which each element of plushy should "Returns the sequence of rates with which each element of plushy should
be mutated when using autoconstructive hypervariability." be mutated when using autoconstructive hypervariability."
[plushy protect-rate hypervariable-rate] [plushy protection rate]
(loop [i 0 (loop [i 0
protected true protected true
rates [] rates []
remainder plushy] remainder plushy]
(if (empty? remainder) (if (empty? remainder)
rates (with-mean rate rates)
(if (and (not protected) (if (and (not protected)
(= (first remainder) :protect)) (= (first remainder) :protect))
(recur i (recur i
@ -222,33 +230,33 @@ The function `new-individual` returns a new individual produced by selection and
(if protected (if protected
(not= (first remainder) :vary) (not= (first remainder) :vary)
false) false)
(conj rates (if protected protect-rate hypervariable-rate)) (conj rates (if protected (/ 1 protection) 1))
(rest remainder)))))) (rest remainder))))))
(defn ah-uniform-addition (defn ah-uniform-addition
"Returns plushy with new instructions possibly added before or after each "Returns plushy with new instructions possibly added before or after each
existing instruction. Rates are autoconstructively hypervariable." existing instruction. Rates are autoconstructively hypervariable."
[plushy instructions protect-rate hypervariable-rate] [plushy instructions protection rate]
(apply concat (apply concat
(map #(if (< (rand) %2) (mapv #(if (< (rand) %2)
(shuffle [%1 (utils/random-instruction instructions)]) (shuffle [%1 (utils/random-instruction instructions)])
[%1]) [%1])
plushy plushy
(ah-rates plushy protect-rate hypervariable-rate)))) (ah-rates plushy protection rate))))
(defn ah-uniform-deletion (defn ah-uniform-deletion
"Randomly deletes instructions from plushy at some rate. "Randomly deletes instructions from plushy at some rate.
Rates are autoconstructively hypervariable." Rates are autoconstructively hypervariable."
[plushy protect-rate hypervariable-rate] [plushy protection rate]
(map first (mapv first
(remove (fn [[_ rate]] (remove (fn [[_ rate]]
(< (rand) (< (rand)
(if (zero? rate) (if (zero? rate)
0 0
(/ 1 (+ 1 (/ 1 rate)))))) (/ 1 (+ 1 (/ 1 rate))))))
(map vector (mapv vector
plushy plushy
(ah-rates plushy protect-rate hypervariable-rate))))) (ah-rates plushy protection rate)))))
(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
@ -256,131 +264,126 @@ The function `new-individual` returns a new individual produced by selection and
[pop argmap] [pop argmap]
(let [umad-parent (selection/select-parent pop argmap) (let [umad-parent (selection/select-parent pop argmap)
parent-ind (:index umad-parent)] ;this is a hack to log hyperselection, only works for umad parent-ind (:index umad-parent)] ;this is a hack to log hyperselection, only works for umad
{:plushy {:plushy
(let [r (rand) (let [r (rand)
op (loop [accum 0.0 op (loop [accum 0.0
ops-probs (vec (:variation argmap))] ops-probs (vec (:variation argmap))]
(if (empty? ops-probs) (if (empty? ops-probs)
:reproduction :reproduction
(let [[op1 prob1] (first ops-probs)] (let [[op1 prob1] (first ops-probs)]
(if (>= (+ accum prob1) r) (if (>= (+ accum prob1) r)
op1 op1
(recur (+ accum prob1) (recur (+ accum prob1)
(rest ops-probs))))))] (rest ops-probs))))))]
(case op (case op
:crossover :crossover
(crossover (crossover
(:plushy (selection/select-parent pop argmap)) (:plushy (selection/select-parent pop argmap))
(:plushy (selection/select-parent pop argmap))) (:plushy (selection/select-parent pop argmap)))
; ;
:tail-aligned-crossover :tail-aligned-crossover
(tail-aligned-crossover (tail-aligned-crossover
(:plushy (selection/select-parent pop argmap)) (:plushy (selection/select-parent pop argmap))
(:plushy (selection/select-parent pop argmap))) (:plushy (selection/select-parent pop argmap)))
; ;
:umad :umad
(let [rate (utils/onenum (:umad-rate argmap))] (let [rate (utils/onenum (:umad-rate argmap))]
(-> (:plushy (selection/select-parent pop argmap)) (-> (:plushy (selection/select-parent pop argmap))
(uniform-addition (:instructions argmap) rate) (uniform-addition (:instructions argmap) rate)
(uniform-deletion rate))) (uniform-deletion rate)))
; uniform mutation by addition and deletion is a uniform mutation operator which ; uniform mutation by addition and deletion is a uniform mutation operator which
;first adds genes with some probability before or after every existing gene and then ;first adds genes with some probability before or after every existing gene and then
;deletes random genes from the resulting genome ;deletes random genes from the resulting genome
; ;
:rumad :rumad
(let [parent-genome (:plushy (selection/select-parent pop argmap)) (let [parent-genome (:plushy (selection/select-parent pop argmap))
after-addition (uniform-addition parent-genome after-addition (uniform-addition parent-genome
(:instructions argmap) (:instructions argmap)
(utils/onenum (:umad-rate argmap))) (utils/onenum (:umad-rate argmap)))
effective-addition-rate (/ (- (count after-addition) effective-addition-rate (/ (- (count after-addition)
(count parent-genome)) (count parent-genome))
(count parent-genome))] (count parent-genome))]
(uniform-deletion after-addition effective-addition-rate)) (uniform-deletion after-addition effective-addition-rate))
; Adds and deletes instructions in the parent genome with the same rate ; Adds and deletes instructions in the parent genome with the same rate
; ;
:vumad ;; variable umad: :umad-rate is interpreted as max, actual uniform 0-max :vumad ;; variable umad: :umad-rate is interpreted as max, actual uniform 0-max
(let [rate (rand (utils/onenum (:umad-rate argmap)))] (let [rate (rand (utils/onenum (:umad-rate argmap)))]
(-> (:plushy (selection/select-parent pop argmap))
(uniform-addition (:instructions argmap) rate)
(uniform-deletion rate)))
;
:ah-umad ;; autoconstructive hypervariability UMAD
(let [protection (utils/onenum (:ah-umad-protection argmap))
rate (utils/onenum (:ah-umad-rate argmap))
parent-genome (:plushy (selection/select-parent pop argmap))]
(-> parent-genome
(ah-uniform-addition (:instructions argmap) protection rate)
(ah-uniform-deletion protection rate)))
;
:uniform-addition
(-> (:plushy (selection/select-parent pop argmap)) (-> (:plushy (selection/select-parent pop argmap))
(uniform-addition (:instructions argmap) rate) (uniform-addition (:instructions argmap)
(uniform-deletion rate))) (utils/onenum (:umad-rate argmap))))
; ;
:ah-umad ;; autoconstructive hypervariability UMAD :uniform-replacement
(let [protect-rate (utils/onenum (:ah-umad-protect-rate argmap))
vary-rate (utils/onenum (:ah-umad-vary-rate argmap))
tourn-size (utils/onenum (:ah-umad-tournament-size argmap))
parent-genome (:plushy (selection/select-parent pop argmap))
offspring (repeatedly
tourn-size
#(-> parent-genome
(ah-uniform-addition (:instructions argmap) protect-rate vary-rate)
(ah-uniform-deletion protect-rate vary-rate)))
hypervariabilities (map #(reduce + (ah-rates % 0 1)) offspring)]
(second (last (sort-by first (map vector hypervariabilities offspring)))))
;
:uniform-addition
(-> (:plushy (selection/select-parent pop argmap))
(uniform-addition (:instructions argmap)
(utils/onenum (:umad-rate argmap))))
;
:uniform-replacement
(-> (:plushy (selection/select-parent pop argmap))
(uniform-replacement (:instructions argmap)
(utils/onenum (:replacement-rate argmap))))
;
:diploid-uniform-silent-replacement
(-> (:plushy (selection/select-parent pop argmap))
(diploid-uniform-silent-replacement (:instructions argmap)
(utils/onenum (:replacement-rate argmap))))
;
:uniform-deletion
(-> (:plushy (selection/select-parent pop argmap))
(uniform-deletion (utils/onenum (:umad-rate argmap))))
;
:diploid-crossover
(diploid-crossover
(:plushy (selection/select-parent pop argmap))
(:plushy (selection/select-parent pop argmap)))
;
:tail-aligned-diploid-crossover
(tail-aligned-diploid-crossover
(:plushy (selection/select-parent pop argmap))
(:plushy (selection/select-parent pop argmap)))
;
:diploid-umad
(let [rate (utils/onenum (:umad-rate argmap))]
(-> (:plushy (selection/select-parent pop argmap)) (-> (:plushy (selection/select-parent pop argmap))
(diploid-uniform-addition (:instructions argmap) rate) (uniform-replacement (:instructions argmap)
(diploid-uniform-deletion rate))) (utils/onenum (:replacement-rate argmap))))
; ;
:diploid-vumad ;; variable umad: :umad-rate is interpreted as max, actual uniform 0-max :diploid-uniform-silent-replacement
(let [rate (rand (utils/onenum (:umad-rate argmap)))]
(-> (:plushy (selection/select-parent pop argmap)) (-> (:plushy (selection/select-parent pop argmap))
(diploid-uniform-addition (:instructions argmap) rate) (diploid-uniform-silent-replacement (:instructions argmap)
(diploid-uniform-deletion rate))) (utils/onenum (:replacement-rate argmap))))
; ;
:diploid-uniform-addition :uniform-deletion
(-> (:plushy (selection/select-parent pop argmap)) (-> (:plushy (selection/select-parent pop argmap))
(diploid-uniform-addition (:instructions argmap) (uniform-deletion (utils/onenum (:umad-rate argmap))))
(utils/onenum (:umad-rate argmap))))
; ;
:diploid-uniform-deletion :diploid-crossover
(-> (:plushy (selection/select-parent pop argmap)) (diploid-crossover
(diploid-uniform-deletion (utils/onenum (:umad-rate argmap)))) (:plushy (selection/select-parent pop argmap))
(:plushy (selection/select-parent pop argmap)))
; ;
:diploid-flip :tail-aligned-diploid-crossover
(-> (:plushy (selection/select-parent pop argmap)) (tail-aligned-diploid-crossover
(diploid-flip (utils/onenum (:diploid-flip-rate argmap)))) (:plushy (selection/select-parent pop argmap))
(:plushy (selection/select-parent pop argmap)))
; ;
:alternation :diploid-umad
(alternation (:plushy (selection/select-parent pop argmap)) (let [rate (utils/onenum (:umad-rate argmap))]
(:plushy (selection/select-parent pop argmap)) (-> (:plushy (selection/select-parent pop argmap))
(utils/onenum (or (:alternation-rate argmap) 0)) (diploid-uniform-addition (:instructions argmap) rate)
(utils/onenum (or (:alignment-deviation argmap) 0))) (diploid-uniform-deletion rate)))
; ;
:reproduction :diploid-vumad ;; variable umad: :umad-rate is interpreted as max, actual uniform 0-max
(:plushy (selection/select-parent pop argmap)) (let [rate (rand (utils/onenum (:umad-rate argmap)))]
(-> (:plushy (selection/select-parent pop argmap))
(diploid-uniform-addition (:instructions argmap) rate)
(diploid-uniform-deletion rate)))
; ;
:else :diploid-uniform-addition
(throw #?(:clj (Exception. (str "No match in new-individual for " op)) (-> (:plushy (selection/select-parent pop argmap))
:cljs (js/Error (diploid-uniform-addition (:instructions argmap)
(str "No match in new-individual for " op))))))})) (utils/onenum (:umad-rate argmap))))
;
:diploid-uniform-deletion
(-> (:plushy (selection/select-parent pop argmap))
(diploid-uniform-deletion (utils/onenum (:umad-rate argmap))))
;
:diploid-flip
(-> (:plushy (selection/select-parent pop argmap))
(diploid-flip (utils/onenum (:diploid-flip-rate argmap))))
;
:alternation
(alternation (:plushy (selection/select-parent pop argmap))
(:plushy (selection/select-parent pop argmap))
(utils/onenum (or (:alternation-rate argmap) 0))
(utils/onenum (or (:alignment-deviation argmap) 0)))
;
: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))))))}))