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

Merge remote-tracking branch 'origin/master' into autox-similarity

Browse Source
This commit is contained in:
Lee Spector 2023-11-08 14:00:51 -05:00
commit be1e2aae78
9 changed files with 41 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
README.md
View File

@ -125,8 +125,9 @@ Calling `(-main)` will run the default genetic programming problem.
## Description
Propel is an implementation of the Push programming
language and the PushGP genetic programming system in Clojure.
Propeller is an implementation of the Push programming
language and the PushGP genetic programming system in Clojure, based
on Tom Helmuth's little PushGP implementation [propel](https://github.com/thelmuth/propel).
For more information on Push and PushGP see
[http://pushlanguage.org](http://pushlanguage.org).

21
src/propeller/gp.cljc
View File

@ -1,12 +1,10 @@
(ns propeller.gp
"Main genetic programming loop."
(:require [clojure.string]
[clojure.pprint]
[propeller.genome :as genome]
[propeller.simplification :as simplification]
[propeller.variation :as variation]
[propeller.downsample :as downsample]
[propeller.hyperselection :as hyperselection]
[propeller.push.instructions.bool]
[propeller.push.instructions.character]
[propeller.push.instructions.code]
@ -22,20 +20,21 @@
"Reports information each generation."
[evaluations pop generation argmap training-data]
(let [best (first pop)]
(clojure.pprint/pprint
(utils/pretty-map-println
{:generation generation
:best-plushy (:plushy best)
:best-program (genome/plushy->push (:plushy best) argmap)
:best-total-error (:total-error best)
:evaluations evaluations
:ds-indices (map #(:index %) training-data)
:ds-indices (if (:downsample? argmap)
(map #(:index %) training-data)
nil)
:best-errors (:errors best)
:best-behaviors (:behaviors best)
:genotypic-diversity (float (/ (count (distinct (map :plushy pop))) (count pop)))
:behavioral-diversity (float (/ (count (distinct (map :behaviors pop))) (count pop)))
:average-genome-length (float (/ (reduce + (map count (map :plushy pop))) (count pop)))
:average-total-error (float (/ (reduce + (map :total-error pop)) (count pop)))})
(println)))
:average-total-error (float (/ (reduce + (map :total-error pop)) (count pop)))})))
(defn cleanup
[]
@ -126,16 +125,14 @@
(+ evaluations (* population-size (count training-data)) ;every member evaluated on the current sample
(if (zero? (mod generation ds-parent-gens)) (* (count parent-reps) (- (count indexed-training-data) (count training-data))) 0) ; the parent-reps not evaluted already on down-sample
(if best-individual-passes-ds (- (count indexed-training-data) (count training-data)) 0)) ; if we checked for generalization or not
(let [reindexed-pop (hyperselection/reindex-pop evaluated-pop argmap)] ; give every individual an index for hyperselection loggin
(hyperselection/log-hyperselection-and-ret
(if (:elitism argmap)
(conj (utils/pmapallv (fn [_] (variation/new-individual reindexed-pop argmap))
(conj (utils/pmapallv (fn [_] (variation/new-individual evaluated-pop argmap))
(range (dec population-size))
argmap)
(first reindexed-pop)) ;elitism maintains the most-fit individual
(utils/pmapallv (fn [_] (variation/new-individual reindexed-pop argmap))
(first evaluated-pop)) ;elitism maintains the most-fit individual
(utils/pmapallv (fn [_] (variation/new-individual evaluated-pop argmap))
(range population-size)
argmap))))
argmap))
(if downsample?
(if (zero? (mod generation ds-parent-gens))
(downsample/update-case-distances rep-evaluated-pop indexed-training-data indexed-training-data ids-type (/ solution-error-threshold (count indexed-training-data))) ; update distances every ds-parent-gens generations

36
src/propeller/hyperselection.cljc
View File

@ -1,36 +0,0 @@
(ns propeller.hyperselection
(:require [propeller.utils :as utils]))
(defn sum-list-map-indices
"sums a list of maps that have the :index property's index multiplicity"
[list-of-maps]
(->> list-of-maps
(map #(:index %))
frequencies))
(defn ordered-freqs
"takes a map from indices to frequencies, and returns a sorted list of the frequences is descencing order"
[freqs]
(->> freqs
vals
(sort >)))
(defn normalize-list-by-popsize [popsize lst]
(map #(double (/ % popsize)) lst))
(defn hyperselection-track
"outputs a normalized list of the hyperselection proportion for each parent"
[new-pop]
(->> new-pop
sum-list-map-indices
ordered-freqs
(normalize-list-by-popsize (count new-pop))))
(defn log-hyperselection-and-ret [new-pop]
(prn {:hyperselection (hyperselection-track new-pop)})
new-pop)
(defn reindex-pop
"assigns each member of the population a unique index before selection to track hyperselection"
[pop argmap]
(utils/pmapallv (fn [indiv index] (assoc indiv :index index)) pop (range (count pop)) argmap))

8
src/propeller/push/instructions/numeric.cljc
View File

@ -183,6 +183,14 @@ Otherwise, acts as a NOOP"
;; FLOAT Instructions only
;; =============================================================================
;; Divides the top two items on the float stack
;; If denominator is 0, returns 1.0
(def-instruction
:float_div
^{:stacks #{:float}}
(fn [state]
(make-instruction state #(float (if (zero? %2) 1 (/ %1 %2))) [:float :float] :float)))
;; Pushes the cosine of the top FLOAT
(def-instruction
:float_cos

2
src/propeller/tools/math.cljc
View File

@ -5,7 +5,7 @@
:cljs js/Math.PI))
(defonce ^{:no-doc true :const true} E #?(:clj Math/E
:cljs js/Math.PI))
:cljs js/Math.E))
(defn step
"returns 1 if number is nonzero, 0 otherwise"

11
src/propeller/utils.cljc
View File

@ -151,3 +151,14 @@
(if (coll? thing-or-collection)
(rand-nth thing-or-collection)
thing-or-collection))
(defn pretty-map-println
"Takes a map and prints it, with each key/value pair on its own line."
[mp]
(print "{")
(let [mp-seq (seq mp)
[first-key first-val] (first mp-seq)]
(println (pr-str first-key first-val))
(doseq [[k v] (rest mp-seq)]
(println (str " " (pr-str k v)))))
(println "}"))

4
src/propeller/variation.cljc
View File

@ -255,8 +255,6 @@ The function `new-individual` returns a new individual produced by selection and
"Returns a new individual produced by selection and variation of
individuals in the population."
[pop argmap]
(let [umad-parent (selection/select-parent pop argmap)
parent-ind (:index umad-parent)] ;this is a hack to log hyperselection, only works for umad
{:plushy
(let [r (rand)
op (loop [accum 0.0
@ -344,4 +342,4 @@ The function `new-individual` returns a new individual produced by selection and
:else
(throw #?(:clj (Exception. (str "No match in new-individual for " op))
:cljs (js/Error
(str "No match in new-individual for " op))))))}))
(str "No match in new-individual for " op))))))})

26
test/propeller/push/downsample_test.cljc
View File

@ -2,8 +2,7 @@
(:require [clojure.test :as t]
[propeller.utils :as u]
[propeller.simplification :as s]
[propeller.downsample :as ds]
[propeller.hyperselection :as hs]))
[propeller.downsample :as ds]))
(t/deftest assign-indices-to-data-test
@ -138,26 +137,3 @@
{:case-delta 0})]
(prn {:selected selected})
(t/is (= 1 (count selected))))))
(t/deftest hyperselection-test
(let [parents1 '({:blah 3 :index 1} {:blah 3 :index 1}
{:blah 3 :index 1} {:blah 3 :index 2})
parents2 '({:plushy 2 :index 0} {:blah 3 :index 2}
{:blah 3 :index 3} {:index 4})
emptyparents '({:blah 1} {:blah 1} {:blah 1})]
(t/testing "sum-list-map-indices function works correctly"
(t/is (= {1 3, 2 1} (hs/sum-list-map-indices parents1)))
(t/is (= {0 1, 2 1, 3 1, 4 1} (hs/sum-list-map-indices parents2))))
(t/testing "ordered-freqs function works correctly"
(t/is (= '(3 1) (hs/ordered-freqs (hs/sum-list-map-indices parents1))))
(t/is (= '(1 1 1 1) (hs/ordered-freqs (hs/sum-list-map-indices parents2)))))
(t/testing "hyperselection-track works correctly"
(t/is (= '(0.75 0.25) (hs/hyperselection-track parents1)))
(t/is (= '(0.25 0.25 0.25 0.25) (hs/hyperselection-track parents2))))
(t/testing "reindex-pop works correctly"
(t/is (= '({:blah 3 :index 0} {:blah 3 :index 1}
{:blah 3 :index 2} {:blah 3 :index 3}) (hs/reindex-pop parents1 {})))
(t/is (= '({:plushy 2 :index 0} {:blah 3 :index 1}
{:blah 3 :index 2} {:index 3}) (hs/reindex-pop parents2 {})))
(t/is (= '({:blah 1 :index 0} {:blah 1 :index 1} {:blah 1 :index 2}) (hs/reindex-pop emptyparents {}))))))

3
test/propeller/utils_test.cljc
View File

@ -2,8 +2,7 @@
(:require [clojure.test :as t]
[propeller.utils :as u]
[propeller.simplification :as s]
[propeller.downsample :as ds]
[propeller.hyperselection :as hs]))
[propeller.downsample :as ds]))
(t/deftest first-non-nil-test
(t/is (= 1 (u/first-non-nil '(1 2 3))))