diff --git a/src/propeller/problems/boolean/mul3.cljc b/src/propeller/problems/boolean/mul3.cljc index 6537d16..ecb6a73 100644 --- a/src/propeller/problems/boolean/mul3.cljc +++ b/src/propeller/problems/boolean/mul3.cljc @@ -104,6 +104,61 @@ [:output :c0] (state/peek-stack state :boolean))))) + +(def-instruction + :c5 + ^{:stacks [:boolean :output]} + (fn [state] + (let [val (:c5 (:output state))] + (if (boolean? val) + (state/push-to-stack state :boolean val) + state)))) + +(def-instruction + :c4 + ^{:stacks [:boolean :output]} + (fn [state] + (let [val (:c4 (:output state))] + (if (boolean? val) + (state/push-to-stack state :boolean val) + state)))) + +(def-instruction + :c3 + ^{:stacks [:boolean :output]} + (fn [state] + (let [val (:c3 (:output state))] + (if (boolean? val) + (state/push-to-stack state :boolean val) + state)))) + +(def-instruction + :c2 + ^{:stacks [:boolean :output]} + (fn [state] + (let [val (:c2 (:output state))] + (if (boolean? val) + (state/push-to-stack state :boolean val) + state)))) + +(def-instruction + :c1 + ^{:stacks [:boolean :output]} + (fn [state] + (let [val (:c1 (:output state))] + (if (boolean? val) + (state/push-to-stack state :boolean val) + state)))) + +(def-instruction + :c0 + ^{:stacks [:boolean :output]} + (fn [state] + (let [val (:c0 (:output state))] + (if (boolean? val) + (state/push-to-stack state :boolean val) + state)))) + (def-instruction :boolean_bufa ^{:stacks #{:boolean}} @@ -113,7 +168,6 @@ [:boolean :boolean] :boolean))) - (def-instruction :boolean_nota ^{:stacks #{:boolean}} @@ -164,12 +218,18 @@ :set-c2 ;; defined here :set-c1 ;; defined here :set-c0 ;; defined here -;; PROVIDE ACCESS ALSO TO c0-c5? - ;; AND/OR BOOLEAN TAGGING? + :c5 ;; defined here + :c4 ;; defined here + :c3 ;; defined here + :c2 ;; defined here + :c1 ;; defined here + :c0 ;; defined here + + ;; BOOLEAN TAGGING? ;; Recommended by Kalkreuth et al: BUFa, NOTa, AND, OR, XOR, NAND, NOR, XNOR - :boolean_bufa ;; defined here - :boolean_nota ;; defined here + ;:boolean_bufa ;; defined here + ;:boolean_nota ;; defined here :boolean_and :boolean_or :boolean_xor @@ -177,10 +237,12 @@ :boolean_nor ;; defined here :boolean_xnor ;; defined here + :boolean_not ;; added to compensate for commenting out :boolean_nota + ;:boolean_pop - ;:boolean_dup - ;:boolean_swap - ;:boolean_rot + :boolean_dup + :boolean_swap + :boolean_rot ;:exec_pop ;:exec_dup @@ -247,8 +309,11 @@ :parent-selection :lexicase ;:parent-selection :tournament :tournament-size 5 - :umad-rate 0.01 - :variation {:umad 1 + :umad-rate 0.05 + :alternation-rate 0.05 + :alignment-deviation 1 + :variation {:umad 0.5 + :alternation 0.5 :reproduction 0 :tail-aligned-crossover 0 } diff --git a/src/propeller/utils.cljc b/src/propeller/utils.cljc index 4ac1cc8..3afef4c 100755 --- a/src/propeller/utils.cljc +++ b/src/propeller/utils.cljc @@ -105,3 +105,26 @@ multicore processor utilization, and 4) takes only one coll so far." (apply await agents) (doall (map deref agents))))) :cljs (mapv f coll))) + +(def PI + #?(:clj Math/PI + :cljs js/Math.PI)) + +(defn log [x] + #?(:clj (Math/log x) + :cljs (js/Math.log x))) + +(defn round [x] + #?(:clj (Math/round x) + :cljs (js/Math.round x))) + +(defn gaussian-noise-factor + "Returns gaussian noise of mean 0, std dev 1." + [] + (* (Math/sqrt (* -2.0 (log (rand)))) + (Math/cos (* 2.0 PI (rand))))) + +(defn perturb-with-gaussian-noise + "Returns n perturbed with std dev sd." + [sd n] + (+ n (* sd (gaussian-noise-factor)))) diff --git a/src/propeller/variation.cljc b/src/propeller/variation.cljc index 36d8321..f012f32 100755 --- a/src/propeller/variation.cljc +++ b/src/propeller/variation.cljc @@ -71,6 +71,29 @@ The function `new-individual` returns a new individual produced by selection and shorter-padded longer)))) +(defn alternation + "Alternates between the two parent genomes." + [genome1 genome2 {:keys [alternation-rate alignment-deviation] :as argmap}] + (let [alternation-rate (or alternation-rate 0) + alignment-deviation (or alignment-deviation 0)] + (loop [i 0 + use-genome1 (rand-nth [true false]) + result-genome [] + iteration-budget (+ (count genome1) (count genome2))] + (if (or (>= i (count (if use-genome1 genome1 genome2))) ;; finished current program + (<= iteration-budget 0)) ;; looping too long + result-genome ;; Return + (if (< (rand) alternation-rate) + (recur (max 0 (+ i (utils/round (* alignment-deviation + (utils/gaussian-noise-factor))))) + (not use-genome1) + result-genome + (dec iteration-budget)) + (recur (inc i) + use-genome1 + (conj result-genome (nth (if use-genome1 genome1 genome2) i)) + (dec iteration-budget))))))) + (defn tail-aligned-crossover "Crosses over two individuals using uniform crossover, one Push instruction at a time. Pads shorter one from the beginning of the list of instructions." @@ -217,7 +240,7 @@ The function `new-individual` returns a new individual produced by selection and ; 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 @@ -228,13 +251,13 @@ The function `new-individual` returns a new individual produced by selection and (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 (:umad-rate argmap))] (-> (:plushy (selection/select-parent pop argmap)) (uniform-addition (:instructions argmap) rate) (uniform-deletion rate))) - + ; :uniform-addition (-> (:plushy (selection/select-parent pop argmap)) (uniform-addition (:instructions argmap) (:umad-rate argmap))) @@ -284,6 +307,11 @@ The function `new-individual` returns a new individual produced by selection and (-> (:plushy (selection/select-parent pop argmap)) (diploid-flip (:diploid-flip-rate argmap))) ; + :alternation + (alternation (:plushy (selection/select-parent pop argmap)) + (:plushy (selection/select-parent pop argmap)) + argmap) + ; :reproduction (:plushy (selection/select-parent pop argmap)) ;