Merge pull request #54 from FluffyChipmunk/master

Added deps.edn
This commit is contained in:
Lee Spector 2023-01-12 21:20:44 -05:00 committed by GitHub
commit 3a04b74633
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
10 changed files with 55 additions and 18 deletions

1
.gitignore vendored
View File

@ -33,3 +33,4 @@ node_modules/
# https://github.com/thelmuth/program-synthesis-benchmark-datasets # https://github.com/thelmuth/program-synthesis-benchmark-datasets
/data /data
**/.DS_Store **/.DS_Store
/.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

@ -46,15 +46,15 @@
(loop [generation 0 (loop [generation 0
population (mapper population (mapper
(fn [_] {:plushy (genome/make-random-plushy instructions max-initial-plushy-size)}) (fn [_] {:plushy (genome/make-random-plushy instructions max-initial-plushy-size)})
(range population-size))] (range population-size))] ;creates population of random plushys
(let [evaluated-pop (sort-by :total-error (let [evaluated-pop (sort-by :total-error
(mapper (mapper
(partial error-function argmap (:training-data argmap)) (partial error-function argmap (:training-data argmap))
population)) population)) ;population sorted by :total-error
best-individual (first evaluated-pop) best-individual (first evaluated-pop)
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) evaluated-pop generation argmap) ((:custom-report argmap) evaluated-pop generation argmap)
(report evaluated-pop generation argmap)) (report evaluated-pop generation argmap))
@ -75,6 +75,6 @@
(if (:elitism argmap) (if (:elitism argmap)
(conj (repeatedly (dec population-size) (conj (repeatedly (dec population-size)
#(variation/new-individual evaluated-pop argmap)) #(variation/new-individual evaluated-pop argmap))
(first evaluated-pop)) (first evaluated-pop)) ;elitism maintains the most-fit individual
(repeatedly population-size (repeatedly population-size
#(variation/new-individual evaluated-pop argmap)))))))) #(variation/new-individual evaluated-pop argmap))))))))

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)))))]
@ -23,6 +27,7 @@
(rest cases)))))) (rest cases))))))
(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)))]
@ -35,7 +40,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

@ -6,6 +6,7 @@
)) ))
(defn choose-random-k (defn choose-random-k
"Takes k random indices"
[k indices] [k indices]
(take k (shuffle indices))) (take k (shuffle indices)))
@ -16,11 +17,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

@ -6,14 +6,18 @@
(defonce E #?(:clj Math/E (defonce E #?(:clj Math/E
:cljs js/Math.PI)) :cljs js/Math.PI))
(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)]
@ -25,6 +29,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

@ -21,7 +21,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)
@ -156,7 +160,10 @@
(-> (: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))
(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
@ -166,7 +173,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)))