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

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

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

View File

@ -24,24 +24,6 @@
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
@ -56,5 +38,9 @@
(zero? (:total-error (first evaluated-pop))) (println "SUCCESS") (zero? (:total-error (first evaluated-pop))) (println "SUCCESS")
(>= generation max-generations) nil (>= generation max-generations) nil
:else (recur (inc generation) :else (recur (inc generation)
(if (:elitism argmap)
(conj (repeatedly (dec population-size)
#(new-individual evaluated-pop argmap))
(first evaluated-pop))
(repeatedly population-size (repeatedly population-size
#(new-individual evaluated-pop argmap)))))))) #(new-individual evaluated-pop argmap))))))))

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))))})