diff --git a/.gitignore b/.gitignore
index 5211373..f46b5a3 100644
--- a/.gitignore
+++ b/.gitignore
@@ -10,6 +10,7 @@ pom.xml.asc
/.nrepl-port
.hgignore
.hg/
+*.iml
+.idea/
out
-notes
-.idea/
\ No newline at end of file
+notes
\ No newline at end of file
diff --git a/propeller.iml b/propeller.iml
index 5c05a54..073e101 100644
--- a/propeller.iml
+++ b/propeller.iml
@@ -5,18 +5,33 @@
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
\ No newline at end of file
diff --git a/src/propeller/core.cljc b/src/propeller/core.cljc
index d88ecc1..720184f 100755
--- a/src/propeller/core.cljc
+++ b/src/propeller/core.cljc
@@ -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)))
diff --git a/src/propeller/genome.cljc b/src/propeller/genome.cljc
index 6c460e2..d032081 100755
--- a/src/propeller/genome.cljc
+++ b/src/propeller/genome.cljc
@@ -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 ] 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 ] 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
diff --git a/src/propeller/gp.cljc b/src/propeller/gp.cljc
index f116eaa..2a46aeb 100755
--- a/src/propeller/gp.cljc
+++ b/src/propeller/gp.cljc
@@ -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
diff --git a/src/propeller/problems/simple_regression.cljc b/src/propeller/problems/simple_regression.cljc
index 9606826..a8c4993 100755
--- a/src/propeller/problems/simple_regression.cljc
+++ b/src/propeller/problems/simple_regression.cljc
@@ -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))))))
diff --git a/src/propeller/problems/software/number_io.cljc b/src/propeller/problems/software/number_io.cljc
index cf8819b..afc449d 100755
--- a/src/propeller/problems/software/number_io.cljc
+++ b/src/propeller/problems/software/number_io.cljc
@@ -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)
diff --git a/src/propeller/problems/software/smallest.cljc b/src/propeller/problems/software/smallest.cljc
index 915043e..c48876b 100755
--- a/src/propeller/problems/software/smallest.cljc
+++ b/src/propeller/problems/software/smallest.cljc
@@ -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)
diff --git a/src/propeller/problems/string_classification.cljc b/src/propeller/problems/string_classification.cljc
index 4d29056..d6d0c0a 100755
--- a/src/propeller/problems/string_classification.cljc
+++ b/src/propeller/problems/string_classification.cljc
@@ -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)))))
\ No newline at end of file
+ ([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))))))
diff --git a/src/propeller/push/instructions/input_output.cljc b/src/propeller/push/instructions/input_output.cljc
index 55db2ee..2a622e1 100755
--- a/src/propeller/push/instructions/input_output.cljc
+++ b/src/propeller/push/instructions/input_output.cljc
@@ -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
diff --git a/src/propeller/push/instructions/polymorphic.cljc b/src/propeller/push/instructions/polymorphic.cljc
index 696ef39..485a64a 100755
--- a/src/propeller/push/instructions/polymorphic.cljc
+++ b/src/propeller/push/instructions/polymorphic.cljc
@@ -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)))))
diff --git a/src/propeller/push/state.cljc b/src/propeller/push/state.cljc
index f06bc89..6cc754e 100755
--- a/src/propeller/push/state.cljc
+++ b/src/propeller/push/state.cljc
@@ -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]
diff --git a/src/propeller/push/utils/globals.cljc b/src/propeller/push/utils/globals.cljc
new file mode 100644
index 0000000..26c37f1
--- /dev/null
+++ b/src/propeller/push/utils/globals.cljc
@@ -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)
\ No newline at end of file
diff --git a/src/propeller/session.cljc b/src/propeller/session.cljc
index 3e626db..7154b7e 100755
--- a/src/propeller/session.cljc
+++ b/src/propeller/session.cljc
@@ -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})
diff --git a/src/propeller/variation.cljc b/src/propeller/variation.cljc
index d04d1f3..d35c452 100755
--- a/src/propeller/variation.cljc
+++ b/src/propeller/variation.cljc
@@ -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))))))})