Merge remote-tracking branch 'upstream/master'

This commit is contained in:
Ryan Boldi 2023-02-17 10:21:26 -05:00
commit 23a8b0648a
10 changed files with 54 additions and 16 deletions

1
.gitignore vendored
View File

@ -34,3 +34,4 @@ node_modules/
/data /data
**/.DS_Store **/.DS_Store
*.edn *.edn
/.cpcache/

7
deps.edn Normal file
View File

@ -0,0 +1,7 @@
{:paths ["src" "target/classes"],
:deps
{org.clojure/clojure #:mvn{:version "1.10.0"},
org.clojure/clojurescript #:mvn{:version "1.9.946"},
org.clojure/test.check #:mvn{:version "1.1.0"},
net.clojars.schneau/psb2 #:mvn{:version "1.1.0"}},
:mvn/repos {}}

View File

@ -3,7 +3,7 @@
[propeller.utils :as utils])) [propeller.utils :as utils]))
(defn make-random-plushy (defn make-random-plushy
"Creates and returns a new plushy." "Creates and returns a new plushy made of random instructions and of a maximum size of max-initial-plushy-size."
[instructions max-initial-plushy-size] [instructions max-initial-plushy-size]
(repeatedly (repeatedly
(rand-int max-initial-plushy-size) (rand-int max-initial-plushy-size)

View File

@ -84,7 +84,7 @@
best-individual-passes-ds (and downsample? (<= (:total-error best-individual) solution-error-threshold)) best-individual-passes-ds (and downsample? (<= (:total-error best-individual) solution-error-threshold))
argmap (if (= (:parent-selection argmap) :epsilon-lexicase) argmap (if (= (:parent-selection argmap) :epsilon-lexicase)
(assoc argmap :epsilons (selection/epsilon-list evaluated-pop)) (assoc argmap :epsilons (selection/epsilon-list evaluated-pop))
argmap)] argmap)] ;adds :epsilons if using epsilon-lexicase
(if (:custom-report argmap) (if (:custom-report argmap)
((:custom-report argmap) evaluations evaluated-pop generation argmap) ((:custom-report argmap) evaluations evaluated-pop generation argmap)
(report evaluations evaluated-pop generation argmap training-data)) (report evaluations evaluated-pop generation argmap training-data))

View File

@ -2,14 +2,18 @@
(:require [propeller.tools.math :as math-tools])) (:require [propeller.tools.math :as math-tools]))
(defn tournament-selection (defn tournament-selection
"Selects an individual from the population using a tournament." "Selects an individual from the population using tournaments of
tournament-size by taking the individual in the tournament with the lowest :total-error. "
[pop argmap] [pop argmap]
(let [tournament-size (:tournament-size argmap) (let [tournament-size (:tournament-size argmap)
tournament-set (take tournament-size (shuffle pop))] tournament-set (take tournament-size (shuffle pop))]
(apply min-key :total-error tournament-set))) (apply min-key :total-error tournament-set)))
(defn lexicase-selection (defn lexicase-selection
"Selects an individual from the population using lexicase selection." "Selects an individual from the population using lexicase selection.
Lexicase parent selection filters the population by considering one random training case at a time,
eliminating any individuals with errors for the current case that are worse than the best error in the selection pool,
until a single individual remains."
[pop argmap] [pop argmap]
(loop [survivors (map rand-nth (vals (group-by :errors pop))) (loop [survivors (map rand-nth (vals (group-by :errors pop)))
cases (shuffle (range (count (:errors (first pop)))))] cases (shuffle (range (count (:errors (first pop)))))]
@ -40,6 +44,7 @@
(recur (+ tot (:fitness (first (rest individuals)))) (rest individuals)))))) (recur (+ tot (:fitness (first (rest individuals)))) (rest individuals))))))
(defn epsilon-list (defn epsilon-list
"List of epsilons for each training case based on median absolute deviation of errors."
[pop] [pop]
(let [error-list (map :errors pop) (let [error-list (map :errors pop)
length (count (:errors (first pop)))] length (count (:errors (first pop)))]
@ -52,7 +57,9 @@
(inc i)))))) (inc i))))))
(defn epsilon-lexicase-selection (defn epsilon-lexicase-selection
"Selects an individual from the population using epsilon-lexicase selection." "Selects an individual from the population using epsilon-lexicase selection.
Epsilon lexicase selection follows the same process as lexicase selection except,
for a test case, only individuals with an error outside of a predefined epsilon are filtered."
[pop argmap] [pop argmap]
(let [epsilons (:epsilons argmap)] (let [epsilons (:epsilons argmap)]
(loop [survivors pop (loop [survivors pop

View File

@ -1,3 +1,10 @@
; The "session" namespace is for trying things out interactively.
; For example, you can use it to test a new Push instruction by running a program that uses it and seeing the result.
; You might just want to do this interactively in the REPL, but the session file makes it a little easier since it alerady
; requires most of the namespaces you'll want to refer to.
; The commented-out stuff is a reminder of how to do some basic things.
(ns propeller.session (ns propeller.session
(:require [propeller.genome :as genome] (:require [propeller.genome :as genome]
[propeller.gp :as gp] [propeller.gp :as gp]

View File

@ -5,6 +5,7 @@
[propeller.tools.math :as math])) [propeller.tools.math :as math]))
(defn choose-random-k (defn choose-random-k
"Takes k random indices"
[k indices] [k indices]
(take k (shuffle indices))) (take k (shuffle indices)))
@ -15,11 +16,12 @@
(keep-indexed #(when (not (some #{%1} sorted-indices)) %2) plushy))) (keep-indexed #(when (not (some #{%1} sorted-indices)) %2) plushy)))
(defn delete-k-random (defn delete-k-random
"Deletes k random instructions from the plushy"
[k plushy] [k plushy]
(delete-at-indices (choose-random-k k (range (count plushy))) plushy)) (delete-at-indices (choose-random-k k (range (count plushy))) plushy))
(defn auto-simplify-plushy (defn auto-simplify-plushy
"naive auto-simplification" "simplifies plushy by deleting instructions that have no impact on errors. naive auto-simplification"
[plushy error-function {:keys [simplification-steps training-data simplification-k simplification-verbose?] :as argmap}] [plushy error-function {:keys [simplification-steps training-data simplification-k simplification-verbose?] :as argmap}]
(when simplification-verbose? (prn {:start-plushy-length (count plushy) :k simplification-k})) (when simplification-verbose? (prn {:start-plushy-length (count plushy) :k simplification-k}))
(let [initial-errors (:errors (error-function argmap training-data {:plushy plushy}))] (let [initial-errors (:errors (error-function argmap training-data {:plushy plushy}))]

View File

@ -10,14 +10,19 @@
"returns 1 if number is nonzero, 0 otherwise" "returns 1 if number is nonzero, 0 otherwise"
[x] [x]
(if (zero? x) 0 1)) (if (zero? x) 0 1))
(defn mean [coll]
(defn mean
"Returns the mean."
[coll]
(let [sum (apply + coll) (let [sum (apply + coll)
count (count coll)] count (count coll)]
(if (pos? count) (if (pos? count)
(/ sum (float count)) (/ sum (float count))
0.0))) 0.0)))
(defn median [coll] (defn median
"Returns the median."
[coll]
(let [sorted (sort coll) (let [sorted (sort coll)
cnt (count sorted) cnt (count sorted)
halfway (quot cnt 2.0)] halfway (quot cnt 2.0)]
@ -29,6 +34,7 @@
(mean [bottom-val top-val]))))) (mean [bottom-val top-val])))))
(defn median-absolute-deviation (defn median-absolute-deviation
"Returns the median absolute deviation."
[coll] [coll]
(let [median-val (median coll)] (let [median-val (median coll)]
(median (map #(Math/abs (- % median-val)) coll)))) (median (map #(Math/abs (- % median-val)) coll))))

View File

@ -35,7 +35,7 @@
lst)) lst))
(defn ensure-list (defn ensure-list
"Returns a non-lazy list if passed a seq argument. Othwrwise, returns a list "Returns a non-lazy list if passed a seq argument. Otherwise, returns a list
containing the argument." containing the argument."
[thing] [thing]
(if (seq? thing) (if (seq? thing)

View File

@ -3,7 +3,8 @@
[propeller.utils :as utils])) [propeller.utils :as utils]))
(defn crossover (defn crossover
"Crosses over two individuals using uniform crossover. Pads shorter one." "Crosses over two individuals using uniform crossover, one Push instruction at a time.
Pads shorter one from the end of the list of instructions."
[plushy-a plushy-b] [plushy-a plushy-b]
(let [shorter (min-key count plushy-a plushy-b) (let [shorter (min-key count plushy-a plushy-b)
longer (if (= shorter plushy-a) longer (if (= shorter plushy-a)
@ -17,7 +18,8 @@
longer)))) longer))))
(defn tail-aligned-crossover (defn tail-aligned-crossover
"Crosses over two individuals using uniform crossover. Pads shorter one on the left." "Crosses over two individuals using uniform crossover, one Push instruction at a time.
Pads shorter one from the beginning of the list of instructions."
[plushy-a plushy-b] [plushy-a plushy-b]
(let [shorter (min-key count plushy-a plushy-b) (let [shorter (min-key count plushy-a plushy-b)
longer (if (= shorter plushy-a) longer (if (= shorter plushy-a)
@ -31,7 +33,8 @@
longer)))) longer))))
(defn diploid-crossover (defn diploid-crossover
"Crosses over two individuals using uniform crossover. Pads shorter one." "Crosses over two individuals using uniform crossover with pairs of Push instructions.
Pads shorter one from the end of the list of instructions."
[plushy-a plushy-b] [plushy-a plushy-b]
(let [plushy-a (partition 2 plushy-a) (let [plushy-a (partition 2 plushy-a)
plushy-b (partition 2 plushy-b) plushy-b (partition 2 plushy-b)
@ -47,7 +50,8 @@
longer))))) longer)))))
(defn tail-aligned-diploid-crossover (defn tail-aligned-diploid-crossover
"Crosses over two individuals using uniform crossover. Pads shorter one on the left." "Crosses over two individuals using uniform crossover with pairs of Push instructions.
Pads shorter one from the beginning of the list of instructions."
[plushy-a plushy-b] [plushy-a plushy-b]
(let [plushy-a (partition 2 plushy-a) (let [plushy-a (partition 2 plushy-a)
plushy-b (partition 2 plushy-b) plushy-b (partition 2 plushy-b)
@ -158,7 +162,10 @@
(-> (:plushy umad-parent) (-> (:plushy umad-parent)
(uniform-addition (:instructions argmap) (:umad-rate argmap)) (uniform-addition (:instructions argmap) (:umad-rate argmap))
(uniform-deletion (:umad-rate argmap))) (uniform-deletion (:umad-rate argmap)))
; ; uniform mutation by addition and deletion is a uniform mutation operator which
;first adds genes with some probability before or after every existing gene and then
;deletes random genes from the resulting genome
:rumad :rumad
(let [parent-genome (:plushy (selection/select-parent pop argmap)) (let [parent-genome (:plushy (selection/select-parent pop argmap))
after-addition (uniform-addition parent-genome after-addition (uniform-addition parent-genome
@ -168,7 +175,8 @@
(count parent-genome)) (count parent-genome))
(count parent-genome))] (count parent-genome))]
(uniform-deletion after-addition effective-addition-rate)) (uniform-deletion after-addition effective-addition-rate))
; ; Adds and deletes instructions in the parent genome with the same rate
:uniform-addition :uniform-addition
(-> (:plushy (selection/select-parent pop argmap)) (-> (:plushy (selection/select-parent pop argmap))
(uniform-addition (:instructions argmap) (:umad-rate argmap))) (uniform-addition (:instructions argmap) (:umad-rate argmap)))