From 6f930841fc00b7ce86b77e2ccbc22f862a6a5fcb Mon Sep 17 00:00:00 2001 From: Mahran-Yousef Date: Wed, 17 Jun 2020 20:09:35 -0400 Subject: [PATCH 1/4] Adding UMAD Rate and variation Adding the ability for the user to modify the UMAD rate that controls the addition and deletion rates and the ability to specify the percentages of new individuals created bu UMAD or crossover --- src/propeller/core.clj | 4 +++- src/propeller/variation.clj | 20 +++++++++++--------- 2 files changed, 14 insertions(+), 10 deletions(-) diff --git a/src/propeller/core.clj b/src/propeller/core.clj index 3e8a77e..cbb22db 100644 --- a/src/propeller/core.clj +++ b/src/propeller/core.clj @@ -13,7 +13,9 @@ :max-initial-plushy-size 50 :step-limit 100 :parent-selection :tournament - :tournament-size 5} + :tournament-size 5 + :UMADRate 0.2 + :variation {:UMAD 0.5 :crossover 0.5}} (apply hash-map (map read-string args))) [:error-function] diff --git a/src/propeller/variation.clj b/src/propeller/variation.clj index 6b6df29..1d174fb 100644 --- a/src/propeller/variation.clj +++ b/src/propeller/variation.clj @@ -18,10 +18,10 @@ (defn uniform-addition "Randomly adds new instructions before every instruction (and at the end of the plushy) with some probability." - [plushy instructions] + [plushy instructions UMADRate] (let [rand-code (repeatedly (inc (count plushy)) (fn [] - (if (< (rand) 0.05) + (if (< (rand) UMADRate) (rand-nth instructions) :mutation-padding)))] (remove #(= % :mutation-padding) @@ -30,8 +30,8 @@ (defn uniform-deletion "Randomly deletes instructions from plushy at some rate." - [plushy] - (remove (fn [x] (< (rand) 0.05)) + [plushy UMADRate] + (remove (fn [x] (< (rand) (/ 1(+ 1 (/ 1 UMADRate))))) plushy)) (defn new-individual @@ -41,8 +41,10 @@ {:plushy (let [prob (rand)] (cond - (< prob 0.5) (crossover (:plushy (select-parent pop argmap)) - (:plushy (select-parent pop argmap))) - (< prob 0.75) (uniform-addition (:plushy (select-parent pop argmap)) - (:instructions argmap)) - :else (uniform-deletion (:plushy (select-parent pop argmap)))))}) \ No newline at end of file + (< prob (:crossover (:variation argmap))) (crossover (:plushy (select-parent pop argmap)) + (:plushy (select-parent pop argmap))) + (< prob (+ (:crossover (:variation argmap)) (/ (:UMAD (:variation argmap)) 2))) (uniform-addition (:plushy (select-parent pop argmap)) + (:instructions argmap) + (:UMADRate argmap)) + :else (uniform-deletion (:plushy (select-parent pop argmap)) + (:UMADRate argmap))))}) \ No newline at end of file From 1d12a365666312483e408fb2c239628d59141ca5 Mon Sep 17 00:00:00 2001 From: Mahran-Yousef Date: Thu, 18 Jun 2020 22:38:45 -0400 Subject: [PATCH 2/4] Fixing previous issues and adding elitism as an option --- src/propeller/gp.clj | 52 +++++++++++++++++++++++++------------ src/propeller/variation.clj | 21 +++++++++------ 2 files changed, 48 insertions(+), 25 deletions(-) diff --git a/src/propeller/gp.clj b/src/propeller/gp.clj index afe1e09..0088377 100644 --- a/src/propeller/gp.clj +++ b/src/propeller/gp.clj @@ -22,21 +22,39 @@ "Main GP loop." [{:keys [population-size max-generations error-function instructions max-initial-plushy-size] - :as argmap}] + :as argmap}] (println "Starting GP with args:" argmap) - (loop [generation 0 - population (repeatedly - population-size - #(hash-map :plushy - (make-random-plushy instructions - max-initial-plushy-size)))] - (let [evaluated-pop (sort-by :total-error - (map (partial error-function argmap) - population))] - (report evaluated-pop generation) - (cond - (zero? (:total-error (first evaluated-pop))) (println "SUCCESS") - (>= generation max-generations) nil - :else (recur (inc generation) - (repeatedly population-size - #(new-individual evaluated-pop argmap))))))) \ No newline at end of file + (if + (:elitism argmap) + (loop [generation 0 + population (repeatedly + population-size + #(hash-map :plushy + (make-random-plushy instructions + max-initial-plushy-size)))] + (let [evaluated-pop (sort-by :total-error + (map (partial error-function argmap) + population))] + (report evaluated-pop generation) + (cond + (zero? (:total-error (first evaluated-pop))) (println "SUCCESS") + (>= generation max-generations) nil + :else (recur (inc generation) + (conj (repeatedly (- population-size 1) + #(new-individual evaluated-pop argmap)) (first evaluated-pop)))))) + (loop [generation 0 + population (repeatedly + population-size + #(hash-map :plushy + (make-random-plushy instructions + max-initial-plushy-size)))] + (let [evaluated-pop (sort-by :total-error + (map (partial error-function argmap) + population))] + (report evaluated-pop generation) + (cond + (zero? (:total-error (first evaluated-pop))) (println "SUCCESS") + (>= generation max-generations) nil + :else (recur (inc generation) + (repeatedly population-size + #(new-individual evaluated-pop argmap)))))))) \ No newline at end of file diff --git a/src/propeller/variation.clj b/src/propeller/variation.clj index 1d174fb..6c613a1 100644 --- a/src/propeller/variation.clj +++ b/src/propeller/variation.clj @@ -31,7 +31,8 @@ (defn uniform-deletion "Randomly deletes instructions from plushy at some rate." [plushy UMADRate] - (remove (fn [x] (< (rand) (/ 1(+ 1 (/ 1 UMADRate))))) + (remove (fn [x] (< (rand) + (/ 1 (+ 1 (/ 1 UMADRate))))) plushy)) (defn new-individual @@ -41,10 +42,14 @@ {:plushy (let [prob (rand)] (cond - (< prob (:crossover (:variation argmap))) (crossover (:plushy (select-parent pop argmap)) - (:plushy (select-parent pop argmap))) - (< prob (+ (:crossover (:variation argmap)) (/ (:UMAD (:variation argmap)) 2))) (uniform-addition (:plushy (select-parent pop argmap)) - (:instructions argmap) - (:UMADRate argmap)) - :else (uniform-deletion (:plushy (select-parent pop argmap)) - (:UMADRate argmap))))}) \ No newline at end of file + (< prob (:crossover (:variation argmap))) + (crossover (:plushy (select-parent pop argmap)) + (:plushy (select-parent pop argmap))) + (< prob (+ (:crossover (:variation argmap)) + (/ (:UMAD (:variation argmap)) 2))) + (do (uniform-addition (:plushy (select-parent pop argmap)) + (:instructions argmap) + (:UMADRate argmap)) + (uniform-deletion (:plushy (select-parent pop argmap)) + (:UMADRate argmap))) + :else (:plushy (select-parent pop argmap))))}) \ No newline at end of file From ef6899d690459c456c4aa64d53c037c29aa08827 Mon Sep 17 00:00:00 2001 From: Mahran-Yousef Date: Fri, 19 Jun 2020 11:12:19 -0400 Subject: [PATCH 3/4] Using lexicase in the demo and reformatting --- propeller.iml | 4 ++-- src/propeller/core.clj | 11 +++++----- src/propeller/genome.clj | 18 ++++++++-------- src/propeller/instructions.clj | 4 ++-- src/propeller/pushstate.clj | 12 +++++------ src/propeller/session.clj | 38 +++++++++++++++++----------------- 6 files changed, 44 insertions(+), 43 deletions(-) diff --git a/propeller.iml b/propeller.iml index bd96178..5c05a54 100644 --- a/propeller.iml +++ b/propeller.iml @@ -5,8 +5,8 @@ - - + + diff --git a/src/propeller/core.clj b/src/propeller/core.clj index cbb22db..5cbbd1e 100644 --- a/src/propeller/core.clj +++ b/src/propeller/core.clj @@ -9,13 +9,14 @@ (gp (update-in (merge {:instructions default-instructions :error-function regression-error-function :max-generations 500 - :population-size 200 + :population-size 500 :max-initial-plushy-size 50 :step-limit 100 - :parent-selection :tournament - :tournament-size 5 - :UMADRate 0.2 - :variation {:UMAD 0.5 :crossover 0.5}} + :parent-selection :lexicase + :tournament-size 20 + :UMADRate 0.2 + :variation {:UMAD 0.5 :crossover 0.5} + :elitism false} (apply hash-map (map read-string args))) [:error-function] diff --git a/src/propeller/genome.clj b/src/propeller/genome.clj index 8d11f7d..9b53ea2 100644 --- a/src/propeller/genome.clj +++ b/src/propeller/genome.clj @@ -4,16 +4,16 @@ (defn push-from-plushy "Returns the Push program expressed by the given plushy representation." [plushy] - (let [opener? #(and (vector? %) (= (first %) 'open))] ;; [open ] marks opens - (loop [push () ;; iteratively build the Push program from the plushy + (let [opener? #(and (vector? %) (= (first %) 'open))] ;; [open ] marks opens + (loop [push () ;; iteratively build the Push program from the plushy plushy (mapcat #(if-let [n (get opens %)] [% ['open n]] [%]) plushy)] - (if (empty? plushy) ;; maybe we're done? - (if (some opener? push) ;; done with plushy, but unclosed open - (recur push '(close)) ;; recur with one more close - push) ;; otherwise, really done, return push + (if (empty? plushy) ;; maybe we're done? + (if (some opener? push) ;; done with plushy, but unclosed open + (recur push '(close)) ;; recur with one more close + push) ;; otherwise, really done, return push (let [i (first plushy)] (if (= i 'close) - (if (some opener? push) ;; process a close when there's an open + (if (some opener? push) ;; process a close when there's an open (recur (let [post-open (reverse (take-while (comp not opener?) (reverse push))) open-index (- (count push) (count post-open) 1) @@ -23,8 +23,8 @@ (concat pre-open [post-open]) (concat pre-open [post-open ['open (dec num-open)]]))) (rest plushy)) - (recur push (rest plushy))) ;; unmatched close, ignore - (recur (concat push [i]) (rest plushy)))))))) ;; anything else + (recur push (rest plushy))) ;; unmatched close, ignore + (recur (concat push [i]) (rest plushy)))))))) ;; anything else (defn make-random-plushy "Creates and returns a new plushy." diff --git a/src/propeller/instructions.clj b/src/propeller/instructions.clj index 1ff0ac2..e78c82e 100644 --- a/src/propeller/instructions.clj +++ b/src/propeller/instructions.clj @@ -38,9 +38,9 @@ "G" "T")) -(def opens ; number of blocks opened by instructions (default = 0) +(def opens ; number of blocks opened by instructions (default = 0) {'exec_dup 1 - 'exec_if 2}) + 'exec_if 2}) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; actual instructions diff --git a/src/propeller/pushstate.clj b/src/propeller/pushstate.clj index eb170f3..7aa8437 100644 --- a/src/propeller/pushstate.clj +++ b/src/propeller/pushstate.clj @@ -2,17 +2,17 @@ (:use [propeller util])) (def example-push-state - {:exec '() + {:exec '() :integer '(1 2 3 4 5 6 7) - :string '("abc") - :input {:in1 4}}) + :string '("abc") + :input {:in1 4}}) (def empty-push-state - {:exec '() + {:exec '() :integer '() - :string '() + :string '() :boolean '() - :input {}}) + :input {}}) (defn push-to-stack "Pushes item onto stack in state" diff --git a/src/propeller/session.clj b/src/propeller/session.clj index ae6c807..767d760 100644 --- a/src/propeller/session.clj +++ b/src/propeller/session.clj @@ -5,37 +5,37 @@ #_(interpret-program '(1 2 integer_+) empty-push-state 1000) #_(interpret-program '(3 5 integer_= exec_if (1 "yes") (2 "no")) - empty-push-state - 1000) + empty-push-state + 1000) #_(interpret-program '(in1 string_reverse 1 string_take "?" string_= exec_if - (in1 " I am asking." string_concat) - (in1 " I am saying." string_concat)) - (assoc empty-push-state :input {:in1 "Can you hear me?"}) - 1000) + (in1 " I am asking." string_concat) + (in1 " I am saying." string_concat)) + (assoc empty-push-state :input {:in1 "Can you hear me?"}) + 1000) #_(interpret-program '(in1 string_reverse 1 string_take "?" string_= exec_if - (in1 " I am asking." string_concat) - (in1 " I am saying." string_concat)) - (assoc empty-push-state :input {:in1 "I can hear you."}) - 1000) + (in1 " I am asking." string_concat) + (in1 " I am saying." string_concat)) + (assoc empty-push-state :input {:in1 "I can hear you."}) + 1000) #_(push-from-plushy (make-random-plushy default-instructions 20)) #_(interpret-program (push-from-plushy (make-random-plushy default-instructions 20)) - (assoc empty-push-state :input {:in1 "I can hear you."}) - 1000) + (assoc empty-push-state :input {:in1 "I can hear you."}) + 1000) ;; Target function: f(x) = x^3 + x + 3 #_(gp {:instructions default-instructions - :error-function regression-error-function - :max-generations 50 - :population-size 200 - :max-initial-plushy-size 50 - :step-limit 100 - :parent-selection :tournament - :tournament-size 5}) + :error-function regression-error-function + :max-generations 50 + :population-size 200 + :max-initial-plushy-size 50 + :step-limit 100 + :parent-selection :tournament + :tournament-size 5}) #_(gp {:instructions default-instructions :error-function string-classification-error-function From eed44cfc065fca2f71c969172b27764402c81186 Mon Sep 17 00:00:00 2001 From: Lee Spector Date: Sat, 20 Jun 2020 00:05:09 -0400 Subject: [PATCH 4/4] Reduce code duplication; additions before/after each gene; deletion runs on result of addition; tweak default parameters --- src/propeller/core.clj | 4 +-- src/propeller/gp.clj | 52 ++++++++++++++----------------------- src/propeller/variation.clj | 29 +++++++++------------ 3 files changed, 33 insertions(+), 52 deletions(-) diff --git a/src/propeller/core.clj b/src/propeller/core.clj index 5cbbd1e..30fbeb9 100644 --- a/src/propeller/core.clj +++ b/src/propeller/core.clj @@ -13,8 +13,8 @@ :max-initial-plushy-size 50 :step-limit 100 :parent-selection :lexicase - :tournament-size 20 - :UMADRate 0.2 + :tournament-size 5 + :UMADRate 0.1 :variation {:UMAD 0.5 :crossover 0.5} :elitism false} (apply hash-map diff --git a/src/propeller/gp.clj b/src/propeller/gp.clj index 0088377..37dd33b 100644 --- a/src/propeller/gp.clj +++ b/src/propeller/gp.clj @@ -24,37 +24,23 @@ max-initial-plushy-size] :as argmap}] (println "Starting GP with args:" argmap) - (if - (:elitism argmap) - (loop [generation 0 - population (repeatedly - population-size - #(hash-map :plushy - (make-random-plushy instructions - max-initial-plushy-size)))] - (let [evaluated-pop (sort-by :total-error - (map (partial error-function argmap) - population))] - (report evaluated-pop generation) - (cond - (zero? (:total-error (first evaluated-pop))) (println "SUCCESS") - (>= generation max-generations) nil - :else (recur (inc generation) - (conj (repeatedly (- population-size 1) - #(new-individual evaluated-pop argmap)) (first evaluated-pop)))))) - (loop [generation 0 - population (repeatedly - population-size - #(hash-map :plushy - (make-random-plushy instructions - max-initial-plushy-size)))] - (let [evaluated-pop (sort-by :total-error - (map (partial error-function argmap) - population))] - (report evaluated-pop generation) - (cond - (zero? (:total-error (first evaluated-pop))) (println "SUCCESS") - (>= generation max-generations) nil - :else (recur (inc generation) + (loop [generation 0 + population (repeatedly + population-size + #(hash-map :plushy + (make-random-plushy instructions + max-initial-plushy-size)))] + (let [evaluated-pop (sort-by :total-error + (map (partial error-function argmap) + population))] + (report evaluated-pop generation) + (cond + (zero? (:total-error (first evaluated-pop))) (println "SUCCESS") + (>= generation max-generations) nil + :else (recur (inc generation) + (if (:elitism argmap) + (conj (repeatedly (dec population-size) + #(new-individual evaluated-pop argmap)) + (first evaluated-pop)) (repeatedly population-size - #(new-individual evaluated-pop argmap)))))))) \ No newline at end of file + #(new-individual evaluated-pop argmap)))))))) diff --git a/src/propeller/variation.clj b/src/propeller/variation.clj index 6c613a1..af6972e 100644 --- a/src/propeller/variation.clj +++ b/src/propeller/variation.clj @@ -16,22 +16,18 @@ longer)))) (defn uniform-addition - "Randomly adds new instructions before every instruction (and at the end of - the plushy) with some probability." + "Returns plushy with new instructions possibly added before or after each existing instruction." [plushy instructions UMADRate] - (let [rand-code (repeatedly (inc (count plushy)) - (fn [] - (if (< (rand) UMADRate) - (rand-nth instructions) - :mutation-padding)))] - (remove #(= % :mutation-padding) - (interleave (conj plushy :mutation-padding) - rand-code)))) + (apply concat + (map #(if (< (rand) UMADRate) + (shuffle [% (rand-nth instructions)]) + [%]) + plushy))) (defn uniform-deletion "Randomly deletes instructions from plushy at some rate." [plushy UMADRate] - (remove (fn [x] (< (rand) + (remove (fn [_] (< (rand) (/ 1 (+ 1 (/ 1 UMADRate))))) plushy)) @@ -46,10 +42,9 @@ (crossover (:plushy (select-parent pop argmap)) (:plushy (select-parent pop argmap))) (< prob (+ (:crossover (:variation argmap)) - (/ (:UMAD (:variation argmap)) 2))) - (do (uniform-addition (:plushy (select-parent pop argmap)) - (:instructions argmap) - (:UMADRate argmap)) - (uniform-deletion (:plushy (select-parent pop argmap)) - (:UMADRate argmap))) + (:UMAD (:variation argmap)) 2)) + (uniform-deletion (uniform-addition (:plushy (select-parent pop argmap)) + (:instructions argmap) + (:UMADRate argmap)) + (:UMADRate argmap)) :else (:plushy (select-parent pop argmap))))}) \ No newline at end of file