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

Fix formatting

Browse Source
This commit is contained in:
Lee Spector 2023-12-10 12:13:48 -05:00
parent 0a32938c2b
commit 39edec3865
1 changed files with 95 additions and 95 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

188
src/propeller/variation.cljc
View File

@ -182,112 +182,112 @@ The function `new-individual` returns a new individual produced by selection and
individuals in the population." individuals in the population."
[pop argmap] [pop argmap]
{:plushy {:plushy
(let [r (rand) (let [r (rand)
op (loop [accum 0.0 op (loop [accum 0.0
ops-probs (vec (:variation argmap))] ops-probs (vec (:variation argmap))]
(if (empty? ops-probs) (if (empty? ops-probs)
:reproduction :reproduction
(let [[op1 prob1] (first ops-probs)] (let [[op1 prob1] (first ops-probs)]
(if (>= (+ accum prob1) r) (if (>= (+ accum prob1) r)
op1 op1
(recur (+ accum prob1) (recur (+ accum prob1)
(rest ops-probs))))))] (rest ops-probs))))))]
(case op (case op
:crossover :crossover
(crossover (crossover
(:plushy (selection/select-parent pop argmap)) (:plushy (selection/select-parent pop argmap))
(:plushy (selection/select-parent pop argmap))) (:plushy (selection/select-parent pop argmap)))
; ;
:tail-aligned-crossover :tail-aligned-crossover
(tail-aligned-crossover (tail-aligned-crossover
(:plushy (selection/select-parent pop argmap)) (:plushy (selection/select-parent pop argmap))
(:plushy (selection/select-parent pop argmap))) (:plushy (selection/select-parent pop argmap)))
; ;
:bmx ;; best match crossover :bmx ;; best match crossover
(let [parent1 (selection/select-parent pop argmap) (let [parent1 (selection/select-parent pop argmap)
parent2 (if (:bmx-complementary? argmap) parent2 (if (:bmx-complementary? argmap)
(selection/select-parent (selection/select-parent
pop pop
(assoc argmap (assoc argmap
:initial-cases :initial-cases
(reverse (:selection-cases parent1)))) (reverse (:selection-cases parent1))))
(selection/select-parent pop argmap)) (selection/select-parent pop argmap))
plushy1 (:plushy parent1) plushy1 (:plushy parent1)
plushy2 (:plushy parent2) plushy2 (:plushy parent2)
bmx-exchange-rate (utils/onenum (or (:bmx-exchange-rate argmap) 0.5)) bmx-exchange-rate (utils/onenum (or (:bmx-exchange-rate argmap) 0.5))
gap-change-prob (utils/onenum (:bmx-gap-change-probability argmap))] gap-change-prob (utils/onenum (:bmx-gap-change-probability argmap))]
(-> (bmx plushy1 plushy2 bmx-exchange-rate) (-> (bmx plushy1 plushy2 bmx-exchange-rate)
(uniform-gap-addition gap-change-prob) (uniform-gap-addition gap-change-prob)
(uniform-gap-deletion gap-change-prob))) (uniform-gap-deletion gap-change-prob)))
; ;
:umad ;; uniform mutation by addition and deletion, see uniform-deletion for the :umad ;; uniform mutation by addition and deletion, see uniform-deletion for the
;; adjustment that makes this size neutral on average ;; adjustment that makes this size neutral on average
(let [rate (utils/onenum (:umad-rate argmap))] (let [rate (utils/onenum (:umad-rate argmap))]
(-> (:plushy (selection/select-parent pop argmap)) (-> (:plushy (selection/select-parent pop argmap))
(uniform-addition (:instructions argmap) rate) (uniform-addition (:instructions argmap) rate)
(uniform-deletion rate))) (uniform-deletion rate)))
; ;
:bmx-umad ;; applies umad to the results of bmx :bmx-umad ;; applies umad to the results of bmx
(let [umad-rate (utils/onenum (:umad-rate argmap)) (let [umad-rate (utils/onenum (:umad-rate argmap))
gap-change-prob (utils/onenum (:bmx-gap-change-probability argmap))] gap-change-prob (utils/onenum (:bmx-gap-change-probability argmap))]
(-> (let [parent1 (selection/select-parent pop argmap) (-> (let [parent1 (selection/select-parent pop argmap)
parent2 (if (:bmx-complementary? argmap) parent2 (if (:bmx-complementary? argmap)
(selection/select-parent pop (selection/select-parent pop
(assoc argmap (assoc argmap
:initial-cases :initial-cases
(reverse (:selection-cases parent1)))) (reverse (:selection-cases parent1))))
(selection/select-parent pop argmap)) (selection/select-parent pop argmap))
plushy1 (:plushy parent1) plushy1 (:plushy parent1)
plushy2 (:plushy parent2) plushy2 (:plushy parent2)
bmx-exchange-rate (utils/onenum (or (:bmx-exchange-rate argmap) 0.5))] bmx-exchange-rate (utils/onenum (or (:bmx-exchange-rate argmap) 0.5))]
(bmx plushy1 plushy2 bmx-exchange-rate)) (bmx plushy1 plushy2 bmx-exchange-rate))
(uniform-gap-addition gap-change-prob) (uniform-gap-addition gap-change-prob)
(uniform-gap-deletion gap-change-prob) (uniform-gap-deletion gap-change-prob)
(uniform-addition (:instructions argmap) umad-rate) (uniform-addition (:instructions argmap) umad-rate)
(uniform-deletion umad-rate))) (uniform-deletion umad-rate)))
; ;
:rumad ;; responsive UMAD, uses a deletion rate computed from the actual :rumad ;; responsive UMAD, uses a deletion rate computed from the actual
;; number of additions made ;; number of additions made
(let [parent-genome (:plushy (selection/select-parent pop argmap)) (let [parent-genome (:plushy (selection/select-parent pop argmap))
after-addition (uniform-addition parent-genome after-addition (uniform-addition parent-genome
(:instructions argmap) (:instructions argmap)
(utils/onenum (:umad-rate argmap))) (utils/onenum (:umad-rate argmap)))
effective-addition-rate (/ (- (count after-addition) effective-addition-rate (/ (- (count after-addition)
(count parent-genome)) (count parent-genome))
(count parent-genome))] (count parent-genome))]
(uniform-deletion after-addition effective-addition-rate)) (uniform-deletion after-addition effective-addition-rate))
; ;
:vumad ;; variable umad: :umad-rate is interpreted as the max, and the :vumad ;; variable umad: :umad-rate is interpreted as the max, and the
;; actual rate is chosen uniformly from the range [0, max) ;; actual rate is chosen uniformly from the range [0, max)
(let [rate (rand (utils/onenum (:umad-rate argmap)))] (let [rate (rand (utils/onenum (:umad-rate argmap)))]
(-> (:plushy (selection/select-parent pop argmap))
(uniform-addition (:instructions argmap) rate)
(uniform-deletion rate)))
;
:uniform-addition
(-> (:plushy (selection/select-parent pop argmap)) (-> (:plushy (selection/select-parent pop argmap))
(uniform-addition (:instructions argmap) (uniform-addition (:instructions argmap) rate)
(utils/onenum (:umad-rate argmap)))) (uniform-deletion rate)))
; ;
:uniform-replacement :uniform-addition
(-> (:plushy (selection/select-parent pop argmap)) (-> (:plushy (selection/select-parent pop argmap))
(uniform-replacement (:instructions argmap) (uniform-addition (:instructions argmap)
(utils/onenum (:replacement-rate argmap)))) (utils/onenum (:umad-rate argmap))))
; ;
:uniform-deletion :uniform-replacement
(-> (:plushy (selection/select-parent pop argmap)) (-> (:plushy (selection/select-parent pop argmap))
(uniform-deletion (utils/onenum (:umad-rate argmap)))) (uniform-replacement (:instructions argmap)
(utils/onenum (:replacement-rate argmap))))
; ;
:alternation :uniform-deletion
(alternation (:plushy (selection/select-parent pop argmap)) (-> (:plushy (selection/select-parent pop argmap))
(:plushy (selection/select-parent pop argmap)) (uniform-deletion (utils/onenum (:umad-rate argmap))))
(utils/onenum (or (:alternation-rate argmap) 0))
(utils/onenum (or (:alignment-deviation argmap) 0)))
; ;
:reproduction :alternation
(:plushy (selection/select-parent pop argmap)) (alternation (:plushy (selection/select-parent pop argmap))
(:plushy (selection/select-parent pop argmap))
(utils/onenum (or (:alternation-rate argmap) 0))
(utils/onenum (or (:alignment-deviation argmap) 0)))
; ;
:else :reproduction
(throw #?(:clj (Exception. (str "No match in new-individual for " op)) (:plushy (selection/select-parent pop argmap))
:cljs (js/Error ;
(str "No match in new-individual for " op))))))}) :else
(throw #?(:clj (Exception. (str "No match in new-individual for " op))
:cljs (js/Error
(str "No match in new-individual for " op))))))})