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

Reduce code duplication; additions before/after each gene; deletion runs on result of addition; tweak default parameters

Browse Source
This commit is contained in:
Lee Spector 2020-06-20 00:05:09 -04:00
parent ef6899d690
commit eed44cfc06
3 changed files with 33 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/propeller/core.clj
View File

@ -13,8 +13,8 @@
:max-initial-plushy-size 50 :max-initial-plushy-size 50
:step-limit 100 :step-limit 100
:parent-selection :lexicase :parent-selection :lexicase
:tournament-size 20 :tournament-size 5
:UMADRate 0.2 :UMADRate 0.1
:variation {:UMAD 0.5 :crossover 0.5} :variation {:UMAD 0.5 :crossover 0.5}
:elitism false} :elitism false}
(apply hash-map (apply hash-map

50
src/propeller/gp.clj
View File

@ -24,37 +24,23 @@
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 (loop [generation 0
(:elitism argmap) population (repeatedly
(loop [generation 0 population-size
population (repeatedly #(hash-map :plushy
population-size (make-random-plushy instructions
#(hash-map :plushy max-initial-plushy-size)))]
(make-random-plushy instructions (let [evaluated-pop (sort-by :total-error
max-initial-plushy-size)))] (map (partial error-function argmap)
(let [evaluated-pop (sort-by :total-error population))]
(map (partial error-function argmap) (report evaluated-pop generation)
population))] (cond
(report evaluated-pop generation) (zero? (:total-error (first evaluated-pop))) (println "SUCCESS")
(cond (>= generation max-generations) nil
(zero? (:total-error (first evaluated-pop))) (println "SUCCESS") :else (recur (inc generation)
(>= generation max-generations) nil (if (:elitism argmap)
:else (recur (inc generation) (conj (repeatedly (dec population-size)
(conj (repeatedly (- population-size 1) #(new-individual evaluated-pop argmap))
#(new-individual evaluated-pop argmap)) (first evaluated-pop)))))) (first evaluated-pop))
(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)
(repeatedly population-size (repeatedly population-size
#(new-individual evaluated-pop argmap)))))))) #(new-individual evaluated-pop argmap))))))))

29
src/propeller/variation.clj
View File

@ -16,22 +16,18 @@
longer)))) longer))))
(defn uniform-addition (defn uniform-addition
"Randomly adds new instructions before every instruction (and at the end of "Returns plushy with new instructions possibly added before or after each existing instruction."
the plushy) with some probability."
[plushy instructions UMADRate] [plushy instructions UMADRate]
(let [rand-code (repeatedly (inc (count plushy)) (apply concat
(fn [] (map #(if (< (rand) UMADRate)
(if (< (rand) UMADRate) (shuffle [% (rand-nth instructions)])
(rand-nth instructions) [%])
:mutation-padding)))] plushy)))
(remove #(= % :mutation-padding)
(interleave (conj plushy :mutation-padding)
rand-code))))
(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) (remove (fn [_] (< (rand)
(/ 1 (+ 1 (/ 1 UMADRate))))) (/ 1 (+ 1 (/ 1 UMADRate)))))
plushy)) plushy))
@ -46,10 +42,9 @@
(crossover (:plushy (select-parent pop argmap)) (crossover (:plushy (select-parent pop argmap))
(:plushy (select-parent pop argmap))) (:plushy (select-parent pop argmap)))
(< prob (+ (:crossover (:variation argmap)) (< prob (+ (:crossover (:variation argmap))
(/ (:UMAD (:variation argmap)) 2))) (:UMAD (:variation argmap)) 2))
(do (uniform-addition (:plushy (select-parent pop argmap)) (uniform-deletion (uniform-addition (:plushy (select-parent pop argmap))
(:instructions argmap) (:instructions argmap)
(:UMADRate argmap)) (:UMADRate argmap))
(uniform-deletion (:plushy (select-parent pop argmap)) (:UMADRate argmap))
(:UMADRate argmap)))
:else (:plushy (select-parent pop argmap))))}) :else (:plushy (select-parent pop argmap))))})