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
.hgignore
.hg/
*.iml
.idea/
out
notes
.idea/

19
propeller.iml
View File

@ -5,18 +5,33 @@
<output-test url="file://$MODULE_DIR$/target/classes" />
<exclude-output />
<content url="file://$MODULE_DIR$">
<sourceFolder url="file://C:\Users\user\Documents\GitHub\propeller\dev-resources" isTestSource="false" />
<sourceFolder url="file://C:\Users\user\Documents\GitHub\propeller\resources" isTestSource="false" />
<sourceFolder url="file://$MODULE_DIR$/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$/test" isTestSource="true" />
<excludeFolder url="file://$MODULE_DIR$/target" />
</content>
<orderEntry type="inheritedJdk" />
<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: 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: 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/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/tools.reader:1.1.0" level="project" />
<orderEntry type="library" name="Leiningen: org.mozilla/rhino:1.7R5" level="project" />
</component>
</module>

18
src/propeller/core.cljc
View File

@ -3,18 +3,26 @@
(:require [propeller.gp :as gp]
[propeller.problems.simple-regression :as regression]
[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]])))
(defn eval-problem-var
[problem-name var-name]
(eval (symbol (str "propeller.problems." problem-name "/" var-name))))
(defn -main
"Runs propel-gp, giving it a map of arguments."
[& 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
(update-in
(merge
{:instructions number-io/instructions
:error-function number-io/error-function
{:instructions (eval-problem-var (first args) "instructions")
:error-function (eval-problem-var (first args) "error-function")
:max-generations 500
:population-size 500
:max-initial-plushy-size 100
@ -25,6 +33,6 @@
:variation {:umad 0.5 :crossover 0.5}
:elitism false}
(apply hash-map
(map read-string args)))
(map read-string (rest args))))
[:error-function]
identity)))

46
src/propeller/genome.cljc
View File

@ -11,25 +11,27 @@
(defn plushy->push
"Returns the Push program expressed by the given plushy representation."
[plushy]
(let [opener? #(and (vector? %) (= (first %) 'open))] ;; [open <n>] marks opens
(loop [push () ;; iteratively build the Push program from the plushy
plushy (mapcat #(if-let [n (get push/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
(let [i (first plushy)]
(if (= i 'close)
(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)
num-open (second (nth push open-index))
pre-open (take open-index push)]
(if (= 1 num-open)
(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
([plushy] (plushy->push plushy {}))
([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
plushy (mapcat #(if-let [n (get push/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
(let [i (first plushy)]
(if (= i 'close)
(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)
num-open (second (nth push open-index))
pre-open (take open-index push)]
(if (= 1 num-open)
(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

9
src/propeller/gp.cljc
View File

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

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

@ -32,31 +32,43 @@
0
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
"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,
or 1000000 if no behavior is produced. The behavior is here defined as the
final top item on the INTEGER stack."
[argmap individual]
(let [program (genome/plushy->push (:plushy individual))
inputs (range -10 11)
correct-outputs (map target-function inputs)
outputs (map (fn [input]
(state/peek-stack
(interpreter/interpret-program
program
(assoc state/empty-state :input {:in1 input})
(:step-limit argmap))
:integer))
inputs)
errors (map (fn [correct-output output]
(if (= output :no-stack-item)
1000000
(math/abs (- correct-output output))))
correct-outputs
outputs)]
(assoc individual
:behaviors outputs
:errors errors
:total-error #?(:clj (apply +' errors)
:cljs (apply + errors)))))
([argmap individual]
(error-function argmap individual :train))
([argmap individual subset]
(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]
(state/peek-stack
(interpreter/interpret-program
program
(assoc state/empty-state :input {:in1 input})
(:step-limit argmap))
:integer))
inputs)
errors (map (fn [correct-output output]
(if (= output :no-stack-item)
1000000
(math/abs (- correct-output output))))
correct-outputs
outputs)]
(assoc individual
:behaviors outputs
:errors errors
:total-error #?(:clj (apply +' errors)
:cljs (apply + errors))))))

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

@ -63,7 +63,7 @@
([argmap individual]
(error-function argmap individual :train))
([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)
inputs (:inputs data)
correct-outputs (:outputs data)

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

@ -65,7 +65,7 @@
([argmap individual]
(error-function argmap individual :train))
([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)
inputs (:inputs data)
correct-outputs (:outputs data)

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

@ -27,7 +27,7 @@
:string_reverse
:string_concat
:string_length
:string_includes?
:string_contains
'close
0
1
@ -40,33 +40,45 @@
"G"
"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
"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
behavior is produced. The behavior is here defined as the final top item on
the BOOLEAN stack."
[argmap individual]
(let [program (genome/plushy->push (:plushy individual))
inputs ["GCG" "GACAG" "AGAAG" "CCCA" "GATTACA" "TAGG" "GACT"]
correct-outputs [false false false false true true true]
outputs (map (fn [input]
(state/peek-stack
(interpreter/interpret-program
program
(assoc state/empty-state :input {:in1 input})
(:step-limit argmap))
:boolean))
inputs)
errors (map (fn [correct-output output]
(if (= output :no-stack-item)
1000000
(if (= correct-output output)
0
1)))
correct-outputs
outputs)]
(assoc individual
:behaviors outputs
:errors errors
:total-error #?(:clj (apply +' errors)
:cljs (apply + errors)))))
([argmap individual]
(error-function argmap individual :train))
([argmap individual subset]
(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]
(state/peek-stack
(interpreter/interpret-program
program
(assoc state/empty-state :input {:in1 input})
(:step-limit argmap))
:boolean))
inputs)
errors (map (fn [correct-output output]
(if (= output :no-stack-item)
1000000
(if (= correct-output output)
0
1)))
correct-outputs
outputs)]
(assoc individual
:behaviors outputs
:errors errors
:total-error #?(:clj (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
;; elements thus labeled from the :input stack and pushing them onto the :exec
;; stack. We can tell whether a particular inN instruction is valid if N-1
;; values are on the input stack.
;; elements thus labeled from the :input map and pushing them onto the :exec
;; stack.
(defn handle-input-instruction
[state instruction]
(if-let [input (instruction (:input state))]
(state/push-to-stack state :exec input)
(throw #?(:clj (Exception. (str "Undefined input instruction " instruction))
(if (contains? (:input state) instruction)
(let [input (instruction (:input state))]
(state/push-to-stack state :exec input))
(throw #?(:clj (Exception. (str "Undefined instruction " instruction))
:cljs (js/Error
(str "Undefined input instruction " instruction))))))
(str "Undefined instruction " instruction))))))
;; =============================================================================
;; OUTPUT Instructions

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

@ -5,6 +5,7 @@
(:require [propeller.utils :as utils]
[propeller.push.state :as state]
[propeller.push.utils.helpers :refer [make-instruction]]
[propeller.push.utils.globals :as globals]
#?(:clj
[propeller.push.utils.macros :refer [def-instruction
generate-instructions]])))
@ -29,7 +30,8 @@
;; 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.
;; 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
^{:stacks #{:integer}}
(fn [stack state]
@ -38,7 +40,8 @@
(and (not= stack :integer)
(not (state/empty-stack? state :integer))
(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)
top-item (state/peek-stack popped-state stack)
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
;; 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.
;; The final number of items on the stack is limited to globals/max-stack-items.
(def _dup_items
^{:stacks #{:integer}}
(fn [stack state]
(if (state/empty-stack? state :integer)
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)
top-items (take n (get popped-state stack))]
(state/push-to-stack-many popped-state stack top-items)))))

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

@ -35,6 +35,11 @@
[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
(defn peek-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.push.core :as push]
[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
'(1 2 integer_add) state/empty-state 1000)
'(1 2 :integer_add) state/empty-state 1000)
#_(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
1000)
#_(interpreter/interpret-program
'(in1 :string_reverse 1 :string_take "?" :string_eq :exec_if
(in1 " I am asking." :string_concat)
(in1 " I am saying." :string_concat))
'(:in1 :string_reverse 1 :string_take "?" :string_eq :exec_if
(:in1 " I am asking." :string_concat)
(:in1 " I am saying." :string_concat))
(assoc state/empty-state :input {:in1 "Can you hear me?"})
1000)
#_(interpreter/interpret-program
'(in1 :string_reverse 1 :string_take "?" :string_eq :exec_if
(in1 " I am asking." :string_concat)
(in1 " I am saying." :string_concat))
'(:in1 :string_reverse 1 :string_take "?" :string_eq :exec_if
(:in1 " I am asking." :string_concat)
(:in1 " I am saying." :string_concat))
(assoc state/empty-state :input {:in1 "I can hear you."})
1000)
#_(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
(genome/plushy->push
(genome/make-random-plushy push/default-instructions 20))
(assoc state/empty-state :input {:in1 "I can hear you."})
1000)
#_(gp/gp {:instructions propeller.problems.software.number-io/instructions
:error-function propeller.problems.software.number-io/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 0.5 :crossover 0.5}
:elitism false})
;; =============================================================================
;; Target function: f(x) = x^3 + x + 3
;; =============================================================================
#_(gp/gp {:instructions push/default-instructions
:error-function regression/error-function
:max-generations 50
:population-size 200
:max-initial-plushy-size 50
:step-limit 100
#_(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 :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
:error-function string-classif/error-function
:max-generations 50
:population-size 200
:max-initial-plushy-size 50
:step-limit 100
:parent-selection :lexicase})
#_(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 :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})

125
src/propeller/variation.cljc
View File

@ -16,6 +16,22 @@
shorter-padded
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
"Returns plushy with new instructions possibly added before or after each
existing instruction."
@ -26,6 +42,26 @@
[%])
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
"Randomly deletes instructions from plushy at some rate."
[plushy umad-rate]
@ -33,20 +69,85 @@
(/ 1 (+ 1 (/ 1 umad-rate)))))
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
"Returns a new individual produced by selection and variation of
individuals in the population."
[pop argmap]
{:plushy
(let [prob (rand)]
(cond
(< prob (:crossover (:variation argmap)))
(crossover (:plushy (selection/select-parent pop argmap))
(:plushy (selection/select-parent pop argmap)))
(< prob (+ (:crossover (:variation argmap))
(:umad (:variation argmap)) 2))
(uniform-deletion (uniform-addition (:plushy (selection/select-parent pop argmap))
(:instructions argmap)
(:umad-rate argmap))
(:umad-rate argmap))
:else (:plushy (selection/select-parent pop argmap))))})
(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)))
;
:umad
(-> (:plushy (selection/select-parent pop argmap))
(uniform-addition (:instructions argmap) (:umad-rate argmap))
(uniform-deletion (:umad-rate 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))))))})