From 37df3432fbd5d907ae6f25ca7b19610e7be03577 Mon Sep 17 00:00:00 2001 From: Lee Spector Date: Wed, 18 Oct 2023 17:05:38 -0400 Subject: [PATCH] Switch to normalized autoconstructive hypervariation; reformat --- src/propeller/gp.cljc | 35 ++- src/propeller/problems/boolean/mul3.cljc | 25 ++- src/propeller/variation.cljc | 261 ++++++++++++----------- 3 files changed, 156 insertions(+), 165 deletions(-) diff --git a/src/propeller/gp.cljc b/src/propeller/gp.cljc index 15b5d36..bfa499f 100644 --- a/src/propeller/gp.cljc +++ b/src/propeller/gp.cljc @@ -23,29 +23,18 @@ [evaluations pop generation argmap training-data] (let [best (first pop)] (clojure.pprint/pprint - (merge {:generation generation - :best-plushy (:plushy best) - :best-program (genome/plushy->push (:plushy best) argmap) - :best-total-error (:total-error best) - :evaluations evaluations - :ds-indices (map #(:index %) training-data) - :best-errors (:errors best) - :best-behaviors (:behaviors best) - :genotypic-diversity (float (/ (count (distinct (map :plushy 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-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))))} - {}))) + {:generation generation + :best-plushy (:plushy best) + :best-program (genome/plushy->push (:plushy best) argmap) + :best-total-error (:total-error best) + :evaluations evaluations + :ds-indices (map #(:index %) training-data) + :best-errors (:errors best) + :best-behaviors (:behaviors best) + :genotypic-diversity (float (/ (count (distinct (map :plushy 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-total-error (float (/ (reduce + (map :total-error pop)) (count pop)))}) (println))) (defn gp diff --git a/src/propeller/problems/boolean/mul3.cljc b/src/propeller/problems/boolean/mul3.cljc index 6403bed..a510d97 100644 --- a/src/propeller/problems/boolean/mul3.cljc +++ b/src/propeller/problems/boolean/mul3.cljc @@ -163,8 +163,8 @@ :boolean_bufa ^{:stacks #{:boolean}} (fn [state] - (make-instruction state - (fn [b1 b2] b1) + (make-instruction state + (fn [b1 b2] b1) [:boolean :boolean] :boolean))) @@ -172,9 +172,9 @@ :boolean_nota ^{:stacks #{:boolean}} (fn [state] - (make-instruction state - (fn [b1 b2] (not b1)) - [:boolean :boolean] + (make-instruction state + (fn [b1 b2] (not b1)) + [:boolean :boolean] :boolean))) @@ -184,7 +184,7 @@ (fn [state] (make-instruction state (fn [b1 b2] (not (and b1 b2))) - [:boolean :boolean] + [:boolean :boolean] :boolean))) (def-instruction @@ -224,7 +224,7 @@ :c2 ;; defined here :c1 ;; defined here :c0 ;; defined here - + ;; BOOLEAN TAGGING? ;; Recommended by Kalkreuth et al: BUFa, NOTa, AND, OR, XOR, NAND, NOR, XNOR @@ -303,21 +303,20 @@ :training-data (:train train-and-test-data) :testing-data (:test train-and-test-data) :max-generations 1000 - :population-size 100 + :population-size 1000 :max-initial-plushy-size 100 - :step-limit 1000 + :step-limit 10000 :parent-selection :lexicase :downsample? true :ds-function :case-rand - :downsample-rate 0.1 + :downsample-rate 0.5 ;:parent-selection :tournament ;:parent-selection :motley-batch-lexicase ;:max-batch-size [1 2 4 8 16 32 64 128 256] ;:tournament-size 5 ;:umad-rate 0.09 - :ah-umad-protect-rate 0.001 ;; ah-umad - :ah-umad-vary-rate 0.1 ;; ah-umad - :ah-umad-tournament-size 1 ;; ah-umad + :ah-umad-protection 10 ;; ah-umad + :ah-umad-rate 0.1 ;; ah-umad ;:umad-rate [1/2 ; 1/4 1/4 ; 1/8 1/8 1/8 diff --git a/src/propeller/variation.cljc b/src/propeller/variation.cljc index d42d95f..8bdadf6 100644 --- a/src/propeller/variation.cljc +++ b/src/propeller/variation.cljc @@ -202,16 +202,24 @@ The function `new-individual` returns a new individual produced by selection and %) (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 "Returns the sequence of rates with which each element of plushy should - be mutated when using autoconstructive hypervariability." - [plushy protect-rate hypervariable-rate] + be mutated when using autoconstructive hypervariability." + [plushy protection rate] (loop [i 0 protected true rates [] remainder plushy] (if (empty? remainder) - rates + (with-mean rate rates) (if (and (not protected) (= (first remainder) :protect)) (recur i @@ -222,33 +230,33 @@ The function `new-individual` returns a new individual produced by selection and (if protected (not= (first remainder) :vary) false) - (conj rates (if protected protect-rate hypervariable-rate)) + (conj rates (if protected (/ 1 protection) 1)) (rest remainder)))))) (defn ah-uniform-addition "Returns plushy with new instructions possibly added before or after each existing instruction. Rates are autoconstructively hypervariable." - [plushy instructions protect-rate hypervariable-rate] + [plushy instructions protection rate] (apply concat - (map #(if (< (rand) %2) - (shuffle [%1 (utils/random-instruction instructions)]) - [%1]) - plushy - (ah-rates plushy protect-rate hypervariable-rate)))) + (mapv #(if (< (rand) %2) + (shuffle [%1 (utils/random-instruction instructions)]) + [%1]) + plushy + (ah-rates plushy protection rate)))) (defn ah-uniform-deletion "Randomly deletes instructions from plushy at some rate. Rates are autoconstructively hypervariable." - [plushy protect-rate hypervariable-rate] - (map first - (remove (fn [[_ rate]] - (< (rand) - (if (zero? rate) - 0 - (/ 1 (+ 1 (/ 1 rate)))))) - (map vector - plushy - (ah-rates plushy protect-rate hypervariable-rate))))) + [plushy protection rate] + (mapv first + (remove (fn [[_ rate]] + (< (rand) + (if (zero? rate) + 0 + (/ 1 (+ 1 (/ 1 rate)))))) + (mapv vector + plushy + (ah-rates plushy protection rate))))) (defn new-individual "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] (let [umad-parent (selection/select-parent pop argmap) parent-ind (:index umad-parent)] ;this is a hack to log hyperselection, only works for umad - {:plushy - (let [r (rand) - op (loop [accum 0.0 - ops-probs (vec (:variation argmap))] - (if (empty? ops-probs) - :reproduction - (let [[op1 prob1] (first ops-probs)] - (if (>= (+ accum prob1) r) - op1 - (recur (+ accum prob1) - (rest ops-probs))))))] - (case op - :crossover - (crossover - (:plushy (selection/select-parent pop argmap)) - (:plushy (selection/select-parent pop argmap))) + {:plushy + (let [r (rand) + op (loop [accum 0.0 + ops-probs (vec (:variation argmap))] + (if (empty? ops-probs) + :reproduction + (let [[op1 prob1] (first ops-probs)] + (if (>= (+ accum prob1) r) + op1 + (recur (+ accum prob1) + (rest ops-probs))))))] + (case op + :crossover + (crossover + (:plushy (selection/select-parent pop argmap)) + (:plushy (selection/select-parent pop argmap))) ; - :tail-aligned-crossover - (tail-aligned-crossover - (:plushy (selection/select-parent pop argmap)) - (:plushy (selection/select-parent pop argmap))) + :tail-aligned-crossover + (tail-aligned-crossover + (:plushy (selection/select-parent pop argmap)) + (:plushy (selection/select-parent pop argmap))) ; - :umad - (let [rate (utils/onenum (:umad-rate argmap))] - (-> (:plushy (selection/select-parent pop argmap)) - (uniform-addition (:instructions argmap) rate) - (uniform-deletion rate))) + :umad + (let [rate (utils/onenum (:umad-rate argmap))] + (-> (:plushy (selection/select-parent pop argmap)) + (uniform-addition (:instructions argmap) rate) + (uniform-deletion rate))) ; 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 ;deletes random genes from the resulting genome ; - :rumad - (let [parent-genome (:plushy (selection/select-parent pop argmap)) - after-addition (uniform-addition parent-genome - (:instructions argmap) - (utils/onenum (:umad-rate argmap))) - effective-addition-rate (/ (- (count after-addition) - (count parent-genome)) - (count parent-genome))] - (uniform-deletion after-addition effective-addition-rate)) + :rumad + (let [parent-genome (:plushy (selection/select-parent pop argmap)) + after-addition (uniform-addition parent-genome + (:instructions argmap) + (utils/onenum (:umad-rate argmap))) + effective-addition-rate (/ (- (count after-addition) + (count parent-genome)) + (count parent-genome))] + (uniform-deletion after-addition effective-addition-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 - (let [rate (rand (utils/onenum (:umad-rate argmap)))] + :vumad ;; variable umad: :umad-rate is interpreted as max, actual uniform 0-max + (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)) - (uniform-addition (:instructions argmap) rate) - (uniform-deletion rate))) + (uniform-addition (:instructions argmap) + (utils/onenum (:umad-rate argmap)))) ; - :ah-umad ;; autoconstructive hypervariability UMAD - (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))] + :uniform-replacement (-> (:plushy (selection/select-parent pop argmap)) - (diploid-uniform-addition (:instructions argmap) rate) - (diploid-uniform-deletion rate))) + (uniform-replacement (:instructions argmap) + (utils/onenum (:replacement-rate argmap)))) ; - :diploid-vumad ;; variable umad: :umad-rate is interpreted as max, actual uniform 0-max - (let [rate (rand (utils/onenum (:umad-rate argmap)))] + :diploid-uniform-silent-replacement (-> (:plushy (selection/select-parent pop argmap)) - (diploid-uniform-addition (:instructions argmap) rate) - (diploid-uniform-deletion rate))) + (diploid-uniform-silent-replacement (:instructions argmap) + (utils/onenum (:replacement-rate argmap)))) ; - :diploid-uniform-addition - (-> (:plushy (selection/select-parent pop argmap)) - (diploid-uniform-addition (:instructions argmap) - (utils/onenum (:umad-rate argmap)))) + :uniform-deletion + (-> (:plushy (selection/select-parent pop argmap)) + (uniform-deletion (utils/onenum (:umad-rate argmap)))) ; - :diploid-uniform-deletion - (-> (:plushy (selection/select-parent pop argmap)) - (diploid-uniform-deletion (utils/onenum (:umad-rate argmap)))) + :diploid-crossover + (diploid-crossover + (:plushy (selection/select-parent pop argmap)) + (:plushy (selection/select-parent pop argmap))) ; - :diploid-flip - (-> (:plushy (selection/select-parent pop argmap)) - (diploid-flip (utils/onenum (:diploid-flip-rate argmap)))) + :tail-aligned-diploid-crossover + (tail-aligned-diploid-crossover + (:plushy (selection/select-parent pop argmap)) + (:plushy (selection/select-parent pop 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))) + :diploid-umad + (let [rate (utils/onenum (:umad-rate argmap))] + (-> (:plushy (selection/select-parent pop argmap)) + (diploid-uniform-addition (:instructions argmap) rate) + (diploid-uniform-deletion rate))) ; - :reproduction - (:plushy (selection/select-parent pop argmap)) + :diploid-vumad ;; variable umad: :umad-rate is interpreted as max, actual uniform 0-max + (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 - (throw #?(:clj (Exception. (str "No match in new-individual for " op)) - :cljs (js/Error - (str "No match in new-individual for " op))))))})) \ No newline at end of file + :diploid-uniform-addition + (-> (:plushy (selection/select-parent pop argmap)) + (diploid-uniform-addition (:instructions argmap) + (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))))))}))