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

Merge branch 'master' into test-vector-instructions

Browse Source
This commit is contained in:
Erik Rauer 2021-01-21 15:19:11 -06:00
commit 68802a9e45
15 changed files with 405 additions and 139 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitignore vendored
View File

@ -10,6 +10,8 @@ pom.xml.asc
/.nrepl-port /.nrepl-port
.hgignore .hgignore
.hg/ .hg/
*.iml
.idea/
out out
notes notes
.idea/ .idea/

19
propeller.iml
View File

@ -5,18 +5,33 @@
<output-test url="file://$MODULE_DIR$/target/classes" /> <output-test url="file://$MODULE_DIR$/target/classes" />
<exclude-output /> <exclude-output />
<content url="file://$MODULE_DIR$"> <content url="file://$MODULE_DIR$">
<sourceFolder url="file://C:\Users\user\Documents\GitHub\propeller\dev-resources" isTestSource="false" /> <sourceFolder url="file://$MODULE_DIR$/resources" isTestSource="false" />
<sourceFolder url="file://C:\Users\user\Documents\GitHub\propeller\resources" isTestSource="false" /> <sourceFolder url="file://$MODULE_DIR$/dev-resources" isTestSource="false" />
<sourceFolder url="file://$MODULE_DIR$/src" isTestSource="false" /> <sourceFolder url="file://$MODULE_DIR$/src" isTestSource="false" />
<sourceFolder url="file://$MODULE_DIR$/test" isTestSource="true" /> <sourceFolder url="file://$MODULE_DIR$/test" isTestSource="true" />
<excludeFolder url="file://$MODULE_DIR$/target" /> <excludeFolder url="file://$MODULE_DIR$/target" />
</content> </content>
<orderEntry type="inheritedJdk" /> <orderEntry type="inheritedJdk" />
<orderEntry type="sourceFolder" forTests="false" /> <orderEntry type="sourceFolder" forTests="false" />
<orderEntry type="library" name="Leiningen: args4j:2.33" level="project" />
<orderEntry type="library" name="Leiningen: clojure-complete:0.2.5" level="project" /> <orderEntry type="library" name="Leiningen: clojure-complete:0.2.5" level="project" />
<orderEntry type="library" name="Leiningen: com.google.code.findbugs/jsr305:3.0.1" level="project" />
<orderEntry type="library" name="Leiningen: com.google.code.gson/gson:2.7" level="project" />
<orderEntry type="library" name="Leiningen: com.google.errorprone/error_prone_annotations:2.0.18" level="project" />
<orderEntry type="library" name="Leiningen: com.google.guava/guava:20.0" level="project" />
<orderEntry type="library" name="Leiningen: com.google.javascript/closure-compiler-externs:v20170910" level="project" />
<orderEntry type="library" name="Leiningen: com.google.javascript/closure-compiler-unshaded:v20170910" level="project" />
<orderEntry type="library" name="Leiningen: com.google.jsinterop/jsinterop-annotations:1.0.0" level="project" />
<orderEntry type="library" name="Leiningen: com.google.protobuf/protobuf-java:3.0.2" level="project" />
<orderEntry type="library" name="Leiningen: nrepl:0.6.0" level="project" /> <orderEntry type="library" name="Leiningen: nrepl:0.6.0" level="project" />
<orderEntry type="library" name="Leiningen: org.clojure/clojure:1.10.0" level="project" /> <orderEntry type="library" name="Leiningen: org.clojure/clojure:1.10.0" level="project" />
<orderEntry type="library" name="Leiningen: org.clojure/clojurescript:1.9.946" level="project" />
<orderEntry type="library" name="Leiningen: org.clojure/core.specs.alpha:0.2.44" level="project" /> <orderEntry type="library" name="Leiningen: org.clojure/core.specs.alpha:0.2.44" level="project" />
<orderEntry type="library" name="Leiningen: org.clojure/data.json:0.2.6" level="project" />
<orderEntry type="library" name="Leiningen: org.clojure/google-closure-library-third-party:0.0-20170809-b9c14c6b" level="project" />
<orderEntry type="library" name="Leiningen: org.clojure/google-closure-library:0.0-20170809-b9c14c6b" level="project" />
<orderEntry type="library" name="Leiningen: org.clojure/spec.alpha:0.2.176" level="project" /> <orderEntry type="library" name="Leiningen: org.clojure/spec.alpha:0.2.176" level="project" />
<orderEntry type="library" name="Leiningen: org.clojure/tools.reader:1.1.0" level="project" />
<orderEntry type="library" name="Leiningen: org.mozilla/rhino:1.7R5" level="project" />
</component> </component>
</module> </module>

18
src/propeller/core.cljc
View File

@ -3,18 +3,26 @@
(:require [propeller.gp :as gp] (:require [propeller.gp :as gp]
[propeller.problems.simple-regression :as regression] [propeller.problems.simple-regression :as regression]
[propeller.problems.string-classification :as string-classif] [propeller.problems.string-classification :as string-classif]
[propeller.problems.software.number-io :as number-io]
[propeller.problems.software.smallest :as smallest]
#?(:cljs [cljs.reader :refer [read-string]]))) #?(:cljs [cljs.reader :refer [read-string]])))
(defn eval-problem-var
[problem-name var-name]
(eval (symbol (str "propeller.problems." problem-name "/" var-name))))
(defn -main (defn -main
"Runs propel-gp, giving it a map of arguments." "Runs propel-gp, giving it a map of arguments."
[& args] [& args]
(when (empty? args)
(println "You must specify a problem to run.")
(println "Try, for example:")
(println " lein run software.smallest")
(System/exit 1))
(require (symbol (str "propeller.problems." (first args))))
(gp/gp (gp/gp
(update-in (update-in
(merge (merge
{:instructions number-io/instructions {:instructions (eval-problem-var (first args) "instructions")
:error-function number-io/error-function :error-function (eval-problem-var (first args) "error-function")
:max-generations 500 :max-generations 500
:population-size 500 :population-size 500
:max-initial-plushy-size 100 :max-initial-plushy-size 100
@ -25,6 +33,6 @@
:variation {:umad 0.5 :crossover 0.5} :variation {:umad 0.5 :crossover 0.5}
:elitism false} :elitism false}
(apply hash-map (apply hash-map
(map read-string args))) (map read-string (rest args))))
[:error-function] [:error-function]
identity))) identity)))

8
src/propeller/genome.cljc
View File

@ -11,8 +11,10 @@
(defn plushy->push (defn plushy->push
"Returns the Push program expressed by the given plushy representation." "Returns the Push program expressed by the given plushy representation."
[plushy] ([plushy] (plushy->push plushy {}))
(let [opener? #(and (vector? %) (= (first %) 'open))] ;; [open <n>] marks opens ([plushy argmap]
(let [plushy (if (:diploid argmap) (map first (partition 2 plushy)) plushy)
opener? #(and (vector? %) (= (first %) 'open))] ;; [open <n>] marks opens
(loop [push () ;; iteratively build the Push program from the plushy (loop [push () ;; iteratively build the Push program from the plushy
plushy (mapcat #(if-let [n (get push/opens %)] [% ['open n]] [%]) plushy)] plushy (mapcat #(if-let [n (get push/opens %)] [% ['open n]] [%]) plushy)]
(if (empty? plushy) ;; maybe we're done? (if (empty? plushy) ;; maybe we're done?
@ -32,4 +34,4 @@
(concat pre-open [post-open ['open (dec num-open)]]))) (concat pre-open [post-open ['open (dec num-open)]])))
(rest plushy)) (rest plushy))
(recur push (rest plushy))) ;; unmatched close, ignore (recur push (rest plushy))) ;; unmatched close, ignore
(recur (concat push [i]) (rest plushy)))))))) ;; anything else (recur (concat push [i]) (rest plushy))))))))) ;; anything else

9
src/propeller/gp.cljc
View File

@ -13,13 +13,13 @@
(defn report (defn report
"Reports information each generation." "Reports information each generation."
[pop generation] [pop generation argmap]
(let [best (first pop)] (let [best (first pop)]
(println "-------------------------------------------------------") (println "-------------------------------------------------------")
(println " Report for Generation" generation) (println " Report for Generation" generation)
(println "-------------------------------------------------------") (println "-------------------------------------------------------")
(print "Best plushy: ") (prn (:plushy best)) (print "Best plushy: ") (prn (:plushy best))
(print "Best program: ") (prn (genome/plushy->push (:plushy best))) (print "Best program: ") (prn (genome/plushy->push (:plushy best) argmap))
(println "Best total error:" (:total-error best)) (println "Best total error:" (:total-error best))
(println "Best errors:" (:errors best)) (println "Best errors:" (:errors best))
(println "Best behaviors:" (:behaviors best)) (println "Best behaviors:" (:behaviors best))
@ -48,7 +48,7 @@
:cljs map) :cljs map)
(partial error-function argmap) population)) (partial error-function argmap) population))
best-individual (first evaluated-pop)] best-individual (first evaluated-pop)]
(report evaluated-pop generation) (report evaluated-pop generation argmap)
(cond (cond
;; Success on training cases is verified on testing cases ;; Success on training cases is verified on testing cases
(zero? (:total-error best-individual)) (zero? (:total-error best-individual))
@ -57,7 +57,8 @@
(if (zero? (:total-error (error-function argmap best-individual :test))) (if (zero? (:total-error (error-function argmap best-individual :test)))
(println "Test cases passed.") (println "Test cases passed.")
(println "Test cases failed.")) (println "Test cases failed."))
(#?(:clj shutdown-agents))) ;(#?(:clj shutdown-agents))
)
;; ;;
(>= generation max-generations) (>= generation max-generations)
nil nil

22
src/propeller/problems/simple_regression.cljc
View File

@ -32,15 +32,27 @@
0 0
1)) 1))
(defn train-and-test-data
[target-function]
(let [train-inputs (range -10 11)
test-inputs (concat (range -20 -10) (range 11 21))]
{:train {:inputs train-inputs
:outputs (map target-function train-inputs)}
:test {:inputs test-inputs
:outputs (map target-function test-inputs)}}))
(defn error-function (defn error-function
"Finds the behaviors and errors of an individual. The error is the absolute "Finds the behaviors and errors of an individual. The error is the absolute
deviation between the target output value and the program's selected behavior, deviation between the target output value and the program's selected behavior,
or 1000000 if no behavior is produced. The behavior is here defined as the or 1000000 if no behavior is produced. The behavior is here defined as the
final top item on the INTEGER stack." final top item on the INTEGER stack."
[argmap individual] ([argmap individual]
(let [program (genome/plushy->push (:plushy individual)) (error-function argmap individual :train))
inputs (range -10 11) ([argmap individual subset]
correct-outputs (map target-function inputs) (let [program (genome/plushy->push (:plushy individual) argmap)
data (get (train-and-test-data target-function) subset)
inputs (:inputs data)
correct-outputs (:outputs data)
outputs (map (fn [input] outputs (map (fn [input]
(state/peek-stack (state/peek-stack
(interpreter/interpret-program (interpreter/interpret-program
@ -59,4 +71,4 @@
:behaviors outputs :behaviors outputs
:errors errors :errors errors
:total-error #?(:clj (apply +' errors) :total-error #?(:clj (apply +' errors)
:cljs (apply + errors))))) :cljs (apply + errors))))))

2
src/propeller/problems/software/number_io.cljc
View File

@ -63,7 +63,7 @@
([argmap individual] ([argmap individual]
(error-function argmap individual :train)) (error-function argmap individual :train))
([argmap individual subset] ([argmap individual subset]
(let [program (genome/plushy->push (:plushy individual)) (let [program (genome/plushy->push (:plushy individual) argmap)
data (get train-and-test-data subset) data (get train-and-test-data subset)
inputs (:inputs data) inputs (:inputs data)
correct-outputs (:outputs data) correct-outputs (:outputs data)

2
src/propeller/problems/software/smallest.cljc
View File

@ -65,7 +65,7 @@
([argmap individual] ([argmap individual]
(error-function argmap individual :train)) (error-function argmap individual :train))
([argmap individual subset] ([argmap individual subset]
(let [program (genome/plushy->push (:plushy individual)) (let [program (genome/plushy->push (:plushy individual) argmap)
data (get train-and-test-data subset) data (get train-and-test-data subset)
inputs (:inputs data) inputs (:inputs data)
correct-outputs (:outputs data) correct-outputs (:outputs data)

24
src/propeller/problems/string_classification.cljc
View File

@ -27,7 +27,7 @@
:string_reverse :string_reverse
:string_concat :string_concat
:string_length :string_length
:string_includes? :string_contains
'close 'close
0 0
1 1
@ -40,15 +40,27 @@
"G" "G"
"T")) "T"))
(defn train-and-test-data
[]
(let [train-inputs ["GCG" "GACAG" "AGAAG" "CCCA" "GATTACA" "TAGG" "GACT"]
test-inputs ["GCGT" "GACTTAG" "AGTAAG" "TCCTCA" "GAACA" "AGG" "GAC"]]
{:train {:inputs train-inputs
:outputs [false false false false true true true]}
:test {:inputs test-inputs
:outputs [true true true true false false false]}}))
(defn error-function (defn error-function
"Finds the behaviors and errors of an individual: Error is 0 if the value and "Finds the behaviors and errors of an individual: Error is 0 if the value and
the program's selected behavior match, or 1 if they differ, or 1000000 if no the program's selected behavior match, or 1 if they differ, or 1000000 if no
behavior is produced. The behavior is here defined as the final top item on behavior is produced. The behavior is here defined as the final top item on
the BOOLEAN stack." the BOOLEAN stack."
[argmap individual] ([argmap individual]
(let [program (genome/plushy->push (:plushy individual)) (error-function argmap individual :train))
inputs ["GCG" "GACAG" "AGAAG" "CCCA" "GATTACA" "TAGG" "GACT"] ([argmap individual subset]
correct-outputs [false false false false true true true] (let [program (genome/plushy->push (:plushy individual) argmap)
data (get (train-and-test-data) subset)
inputs (:inputs data)
correct-outputs (:outputs data)
outputs (map (fn [input] outputs (map (fn [input]
(state/peek-stack (state/peek-stack
(interpreter/interpret-program (interpreter/interpret-program
@ -69,4 +81,4 @@
:behaviors outputs :behaviors outputs
:errors errors :errors errors
:total-error #?(:clj (apply +' errors) :total-error #?(:clj (apply +' errors)
:cljs (apply + errors))))) :cljs (apply + errors))))))

14
src/propeller/push/instructions/input_output.cljc
View File

@ -12,16 +12,16 @@
;; ============================================================================= ;; =============================================================================
;; Allows Push to handle input instructions of the form :inN, e.g. :in2, taking ;; Allows Push to handle input instructions of the form :inN, e.g. :in2, taking
;; elements thus labeled from the :input stack and pushing them onto the :exec ;; elements thus labeled from the :input map and pushing them onto the :exec
;; stack. We can tell whether a particular inN instruction is valid if N-1 ;; stack.
;; values are on the input stack.
(defn handle-input-instruction (defn handle-input-instruction
[state instruction] [state instruction]
(if-let [input (instruction (:input state))] (if (contains? (:input state) instruction)
(state/push-to-stack state :exec input) (let [input (instruction (:input state))]
(throw #?(:clj (Exception. (str "Undefined input instruction " instruction)) (state/push-to-stack state :exec input))
(throw #?(:clj (Exception. (str "Undefined instruction " instruction))
:cljs (js/Error :cljs (js/Error
(str "Undefined input instruction " instruction)))))) (str "Undefined instruction " instruction))))))
;; ============================================================================= ;; =============================================================================
;; OUTPUT Instructions ;; OUTPUT Instructions

11
src/propeller/push/instructions/polymorphic.cljc
View File

@ -5,6 +5,7 @@
(:require [propeller.utils :as utils] (:require [propeller.utils :as utils]
[propeller.push.state :as state] [propeller.push.state :as state]
[propeller.push.utils.helpers :refer [make-instruction]] [propeller.push.utils.helpers :refer [make-instruction]]
[propeller.push.utils.globals :as globals]
#?(:clj #?(:clj
[propeller.push.utils.macros :refer [def-instruction [propeller.push.utils.macros :refer [def-instruction
generate-instructions]]))) generate-instructions]])))
@ -29,7 +30,8 @@
;; its argument (since that would negate the effect of the duplication). The ;; its argument (since that would negate the effect of the duplication). The
;; number n is determined by the top INTEGER. For n = 0, equivalent to POP. ;; number n is determined by the top INTEGER. For n = 0, equivalent to POP.
;; For n = 1, equivalent to NOOP. For n = 2, equivalent to DUP. Negative values ;; For n = 1, equivalent to NOOP. For n = 2, equivalent to DUP. Negative values
;; of n are treated as 0 ;; of n are treated as 0. The final number of items on the stack is limited to
;; globals/max-stack-items.
(def _dup_times (def _dup_times
^{:stacks #{:integer}} ^{:stacks #{:integer}}
(fn [stack state] (fn [stack state]
@ -38,7 +40,8 @@
(and (not= stack :integer) (and (not= stack :integer)
(not (state/empty-stack? state :integer)) (not (state/empty-stack? state :integer))
(not (state/empty-stack? state stack)))) (not (state/empty-stack? state stack))))
(let [n (state/peek-stack state :integer) (let [n (min (state/peek-stack state :integer)
(inc (- globals/max-stack-items (state/stack-size state stack))))
popped-state (state/pop-stack state :integer) popped-state (state/pop-stack state :integer)
top-item (state/peek-stack popped-state stack) top-item (state/peek-stack popped-state stack)
top-item-dup (take (- n 1) (repeat top-item))] top-item-dup (take (- n 1) (repeat top-item))]
@ -50,12 +53,14 @@
;; Duplicates the top n items on the stack, one time each. The number n is ;; Duplicates the top n items on the stack, one time each. The number n is
;; determined by the top INTEGER. If n <= 0, no items will be duplicated. If ;; determined by the top INTEGER. If n <= 0, no items will be duplicated. If
;; fewer than n items are on the stack, the entire stack will be duplicated. ;; fewer than n items are on the stack, the entire stack will be duplicated.
;; The final number of items on the stack is limited to globals/max-stack-items.
(def _dup_items (def _dup_items
^{:stacks #{:integer}} ^{:stacks #{:integer}}
(fn [stack state] (fn [stack state]
(if (state/empty-stack? state :integer) (if (state/empty-stack? state :integer)
state state
(let [n (state/peek-stack state :integer) (let [n (min (state/peek-stack state :integer)
(- globals/max-stack-items (state/stack-size state stack)))
popped-state (state/pop-stack state :integer) popped-state (state/pop-stack state :integer)
top-items (take n (get popped-state stack))] top-items (take n (get popped-state stack))]
(state/push-to-stack-many popped-state stack top-items))))) (state/push-to-stack-many popped-state stack top-items)))))

5
src/propeller/push/state.cljc
View File

@ -35,6 +35,11 @@
[state stack] [state stack]
(empty? (get state stack))) (empty? (get state stack)))
;; Returns the stack size
(defn stack-size
[state stack]
(count (get state stack)))
;; Returns the top item on the stack ;; Returns the top item on the stack
(defn peek-stack (defn peek-stack
[state stack] [state stack]

11
src/propeller/push/utils/globals.cljc Normal file
View File

@ -0,0 +1,11 @@
(ns propeller.push.utils.globals)
;; =============================================================================
;; Values used by the Push instructions to keep the stack sizes within
;; reasonable limits.
;; =============================================================================
;; Limits the number of items that can be duplicated onto a stack at once.
;; We might want to extend this to limit all the different that things may be
;; placed on a stack.
(def max-stack-items 100)

158
src/propeller/session.cljc
View File

@ -7,56 +7,148 @@
[propeller.problems.string-classification :as string-classif] [propeller.problems.string-classification :as string-classif]
[propeller.push.core :as push] [propeller.push.core :as push]
[propeller.push.interpreter :as interpreter] [propeller.push.interpreter :as interpreter]
[propeller.push.state :as state])) [propeller.push.state :as state]
[propeller.push.utils.helpers :refer [get-stack-instructions]]))
#_(interpreter/interpret-program #_(interpreter/interpret-program
'(1 2 integer_add) state/empty-state 1000) '(1 2 :integer_add) state/empty-state 1000)
#_(interpreter/interpret-program #_(interpreter/interpret-program
'(3 5 :integer_eq :exec_if (1 "yes") (2 "no")) '(3 3 :integer_eq :exec_if (1 "yes") (2 "no"))
state/empty-state state/empty-state
1000) 1000)
#_(interpreter/interpret-program #_(interpreter/interpret-program
'(in1 :string_reverse 1 :string_take "?" :string_eq :exec_if '(:in1 :string_reverse 1 :string_take "?" :string_eq :exec_if
(in1 " I am asking." :string_concat) (:in1 " I am asking." :string_concat)
(in1 " I am saying." :string_concat)) (:in1 " I am saying." :string_concat))
(assoc state/empty-state :input {:in1 "Can you hear me?"}) (assoc state/empty-state :input {:in1 "Can you hear me?"})
1000) 1000)
#_(interpreter/interpret-program #_(interpreter/interpret-program
'(in1 :string_reverse 1 :string_take "?" :string_eq :exec_if '(:in1 :string_reverse 1 :string_take "?" :string_eq :exec_if
(in1 " I am asking." :string_concat) (:in1 " I am asking." :string_concat)
(in1 " I am saying." :string_concat)) (:in1 " I am saying." :string_concat))
(assoc state/empty-state :input {:in1 "I can hear you."}) (assoc state/empty-state :input {:in1 "I can hear you."})
1000) 1000)
#_(genome/plushy->push #_(genome/plushy->push
(genome/make-random-plushy push/default-instructions 20)) (genome/make-random-plushy (get-stack-instructions #{:float :integer :exec :boolean}) 20))
#_(interpreter/interpret-program #_(gp/gp {:instructions propeller.problems.software.number-io/instructions
(genome/plushy->push :error-function propeller.problems.software.number-io/error-function
(genome/make-random-plushy push/default-instructions 20)) :max-generations 500
(assoc state/empty-state :input {:in1 "I can hear you."}) :population-size 500
1000) :max-initial-plushy-size 100
:step-limit 200
:parent-selection :lexicase
:tournament-size 5
:umad-rate 0.1
:variation {:umad 0.5 :crossover 0.5}
:elitism false})
;; ============================================================================= #_(gp/gp {:instructions propeller.problems.simple-regression/instructions
;; Target function: f(x) = x^3 + x + 3 :error-function propeller.problems.simple-regression/error-function
;; ============================================================================= :max-generations 500
:population-size 500
#_(gp/gp {:instructions push/default-instructions :max-initial-plushy-size 100
:error-function regression/error-function :step-limit 200
:max-generations 50
:population-size 200
:max-initial-plushy-size 50
:step-limit 100
:parent-selection :tournament :parent-selection :tournament
:tournament-size 5}) :tournament-size 5
:umad-rate 0.01
:variation {:umad 1.0
:crossover 0.0}
:elitism false})
#_(gp/gp {:instructions push/default-instructions #_(gp/gp {:instructions propeller.problems.simple-regression/instructions
:error-function string-classif/error-function :error-function propeller.problems.simple-regression/error-function
:max-generations 50 :max-generations 500
:population-size 200 :population-size 500
:max-initial-plushy-size 50 :max-initial-plushy-size 100
:step-limit 100 :step-limit 200
:parent-selection :lexicase}) :parent-selection :tournament
:tournament-size 5
:umad-rate 0.1
:variation {:umad 1.0
:crossover 0.0}
:elitism false})
#_(gp/gp {:instructions propeller.problems.simple-regression/instructions
:error-function propeller.problems.simple-regression/error-function
:max-generations 500
:population-size 500
:max-initial-plushy-size 100
:step-limit 200
:parent-selection :lexicase
:tournament-size 5
:umad-rate 0.1
:variation {:umad 1.0
:crossover 0.0}
:elitism false})
#_(gp/gp {:instructions propeller.problems.simple-regression/instructions
:error-function propeller.problems.simple-regression/error-function
:max-generations 500
:population-size 500
:max-initial-plushy-size 100
:step-limit 200
:parent-selection :lexicase
:tournament-size 5
:umad-rate 0.1
:diploid-flip-rate 0.1
:variation {:umad 0.8
:diploid-flip 0.2}
:elitism false
:diploid true})
#_(gp/gp {:instructions propeller.problems.software.smallest/instructions
:error-function propeller.problems.software.smallest/error-function
:max-generations 500
:population-size 500
:max-initial-plushy-size 100
:step-limit 200
:parent-selection :lexicase
:tournament-size 5
:umad-rate 0.1
:diploid-flip-rate 0.1
:variation {;:umad 0.8
;:diploid-flip 0.2
:umad 1
}
:elitism false
:diploid false})
#_(gp/gp {:instructions propeller.problems.software.smallest/instructions
:error-function propeller.problems.software.smallest/error-function
:max-generations 500
:population-size 500
:max-initial-plushy-size 200 ;100
:step-limit 200
:parent-selection :lexicase
:tournament-size 5
:umad-rate 0.1
:diploid-flip-rate 0.1
:variation {:umad 0.8
:diploid-flip 0.2
;:umad 1
}
:elitism false
:diploid true})
#_(gp/gp {:instructions propeller.problems.string-classification/instructions
:error-function propeller.problems.string-classification/error-function
:max-generations 500
:population-size 500
:max-initial-plushy-size 100
:step-limit 200
:parent-selection :lexicase
:tournament-size 5
:umad-rate 0.1
:diploid-flip-rate 0.1
:variation {:umad 0.8
:diploid-flip 0.2
}
:elitism false
:diploid true})

123
src/propeller/variation.cljc
View File

@ -16,6 +16,22 @@
shorter-padded shorter-padded
longer)))) longer))))
(defn diploid-crossover
"Crosses over two individuals using uniform crossover. Pads shorter one."
[plushy-a plushy-b]
(let [plushy-a (partition 2 plushy-a)
plushy-b (partition 2 plushy-b)
shorter (min-key count plushy-a plushy-b)
longer (if (= shorter plushy-a)
plushy-b
plushy-a)
length-diff (- (count longer) (count shorter))
shorter-padded (concat shorter (repeat length-diff :crossover-padding))]
(flatten (remove #(= % :crossover-padding)
(map #(if (< (rand) 0.5) %1 %2)
shorter-padded
longer)))))
(defn uniform-addition (defn 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." existing instruction."
@ -26,6 +42,26 @@
[%]) [%])
plushy))) plushy)))
(defn uniform-replacement
"Returns plushy with new instructions possibly replacing existing
instructions."
[plushy instructions replacement-rate]
(map #(if (< (rand) replacement-rate)
(utils/random-instruction instructions)
%)
plushy))
(defn diploid-uniform-addition
"Returns plushy with new instructions possibly added before or after each
existing instruction."
[plushy instructions umad-rate]
(flatten
(map (fn [pair]
(if (< (rand) umad-rate)
(shuffle [pair (repeatedly 2 #(utils/random-instruction instructions))])
[pair]))
(partition 2 plushy))))
(defn uniform-deletion (defn uniform-deletion
"Randomly deletes instructions from plushy at some rate." "Randomly deletes instructions from plushy at some rate."
[plushy umad-rate] [plushy umad-rate]
@ -33,20 +69,85 @@
(/ 1 (+ 1 (/ 1 umad-rate))))) (/ 1 (+ 1 (/ 1 umad-rate)))))
plushy)) plushy))
(defn diploid-uniform-deletion
"Randomly deletes instructions from plushy at some rate."
[plushy umad-rate]
(flatten (remove (fn [_] (< (rand)
(/ 1 (+ 1 (/ 1 umad-rate)))))
(partition 2 plushy))))
(defn diploid-flip
"Randomly flips pairs in a diploid plushy at some rate."
[plushy flip-rate]
(flatten (map #(if (< (rand) flip-rate)
(reverse %)
%)
(partition 2 plushy))))
(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
individuals in the population." individuals in the population."
[pop argmap] [pop argmap]
{:plushy {:plushy
(let [prob (rand)] (let [r (rand)
(cond op (loop [accum 0.0
(< prob (:crossover (:variation argmap))) ops-probs (vec (:variation argmap))]
(crossover (:plushy (selection/select-parent pop 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 (selection/select-parent pop argmap)))
(< prob (+ (:crossover (:variation argmap)) ;
(:umad (:variation argmap)) 2)) :umad
(uniform-deletion (uniform-addition (: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)) ;
:else (:plushy (selection/select-parent pop argmap))))}) :uniform-addition
(-> (:plushy (selection/select-parent pop argmap))
(uniform-addition (:instructions argmap) (:umad-rate argmap)))
;
:uniform-replacement
(-> (:plushy (selection/select-parent pop argmap))
(uniform-replacement (:instructions argmap) (:replacement-rate 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))))))})