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

Fixing previous issues and adding elitism as an option

Browse Source
This commit is contained in:
Mahran-Yousef 2020-06-18 22:38:45 -04:00
parent 6f930841fc
commit 1d12a36566
2 changed files with 48 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
src/propeller/gp.clj
View File

@ -24,6 +24,24 @@
max-initial-plushy-size] max-initial-plushy-size]
:as argmap}] :as argmap}]
(println "Starting GP with args:" argmap) (println "Starting GP with args:" argmap)
(if
(:elitism argmap)
(loop [generation 0
population (repeatedly
population-size
#(hash-map :plushy
(make-random-plushy instructions
max-initial-plushy-size)))]
(let [evaluated-pop (sort-by :total-error
(map (partial error-function argmap)
population))]
(report evaluated-pop generation)
(cond
(zero? (:total-error (first evaluated-pop))) (println "SUCCESS")
(>= generation max-generations) nil
:else (recur (inc generation)
(conj (repeatedly (- population-size 1)
#(new-individual evaluated-pop argmap)) (first evaluated-pop))))))
(loop [generation 0 (loop [generation 0
population (repeatedly population (repeatedly
population-size population-size
@ -39,4 +57,4 @@
(>= generation max-generations) nil (>= generation max-generations) nil
:else (recur (inc generation) :else (recur (inc generation)
(repeatedly population-size (repeatedly population-size
#(new-individual evaluated-pop argmap))))))) #(new-individual evaluated-pop argmap))))))))

15
src/propeller/variation.clj
View File

@ -31,7 +31,8 @@
(defn uniform-deletion (defn uniform-deletion
"Randomly deletes instructions from plushy at some rate." "Randomly deletes instructions from plushy at some rate."
[plushy UMADRate] [plushy UMADRate]
(remove (fn [x] (< (rand) (/ 1(+ 1 (/ 1 UMADRate))))) (remove (fn [x] (< (rand)
(/ 1 (+ 1 (/ 1 UMADRate)))))
plushy)) plushy))
(defn new-individual (defn new-individual
@ -41,10 +42,14 @@
{:plushy {:plushy
(let [prob (rand)] (let [prob (rand)]
(cond (cond
(< prob (:crossover (:variation argmap))) (crossover (:plushy (select-parent pop argmap)) (< prob (:crossover (:variation argmap)))
(crossover (:plushy (select-parent pop argmap))
(:plushy (select-parent pop argmap))) (:plushy (select-parent pop argmap)))
(< prob (+ (:crossover (:variation argmap)) (/ (:UMAD (:variation argmap)) 2))) (uniform-addition (:plushy (select-parent pop argmap)) (< prob (+ (:crossover (:variation argmap))
(/ (:UMAD (:variation argmap)) 2)))
(do (uniform-addition (:plushy (select-parent pop argmap))
(:instructions argmap) (:instructions argmap)
(:UMADRate argmap)) (:UMADRate argmap))
:else (uniform-deletion (:plushy (select-parent pop argmap)) (uniform-deletion (:plushy (select-parent pop argmap))
(:UMADRate argmap))))}) (:UMADRate argmap)))
:else (:plushy (select-parent pop argmap))))})