Fixing previous issues and adding elitism as an option

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

View File

@ -22,21 +22,39 @@
"Main GP loop."
[{:keys [population-size max-generations error-function instructions
max-initial-plushy-size]
:as argmap}]
:as argmap}]
(println "Starting GP with args:" 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)
(repeatedly population-size
#(new-individual evaluated-pop 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
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
#(new-individual evaluated-pop argmap))))))))

View File

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