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

Pass argmap to random-instruction

Browse Source
This commit is contained in:
Lee Spector 2023-12-31 16:02:49 -05:00
parent d8402962f1
commit 5eb34a811a
3 changed files with 17 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
src/propeller/genome.cljc
View File

@ -7,9 +7,10 @@ They hold the genetic material for an `individual`. In the initial population, w
(defn make-random-plushy (defn make-random-plushy
"Creates and returns a new plushy made of random instructions." "Creates and returns a new plushy made of random instructions."
[{:keys [instructions max-initial-plushy-size bmx? bmx-gene-length-limit]}] [{:keys [instructions max-initial-plushy-size bmx? bmx-gene-length-limit]
:as argmap}]
(let [plushy (repeatedly (rand-int max-initial-plushy-size) (let [plushy (repeatedly (rand-int max-initial-plushy-size)
#(utils/random-instruction instructions))] #(utils/random-instruction instructions argmap))]
(if bmx? (if bmx?
(-> plushy (-> plushy
(utils/remove-empty-genes) (utils/remove-empty-genes)

2
src/propeller/utils.cljc
View File

@ -49,7 +49,7 @@
(defn random-instruction (defn random-instruction
"Returns a random instruction from a supplied pool of instructions, evaluating "Returns a random instruction from a supplied pool of instructions, evaluating
ERC-producing functions to a constant literal." ERC-producing functions to a constant literal."
[instructions] [instructions argmap]
(let [instruction (rand-nth instructions)] (let [instruction (rand-nth instructions)]
(if (fn? instruction) (if (fn? instruction)
(instruction) (instruction)

23
src/propeller/variation.cljc
View File

@ -110,20 +110,20 @@ The function `new-individual` returns a new individual produced by selection and
(defn uniform-addition (defn uniform-addition
"Returns plushy with new instructions possibly added before or after each "Returns plushy with new instructions possibly added before or after each
existing instruction." existing instruction."
[plushy instructions umad-rate] [plushy instructions umad-rate argmap]
(apply concat (apply concat
(map #(if (and (not= % :gap) (map #(if (and (not= % :gap)
(< (rand) umad-rate)) (< (rand) umad-rate))
(shuffle [% (utils/random-instruction instructions)]) (shuffle [% (utils/random-instruction instructions argmap)])
[%]) [%])
plushy))) plushy)))
(defn uniform-replacement (defn uniform-replacement
"Returns plushy with new instructions possibly replacing existing "Returns plushy with new instructions possibly replacing existing
instructions." instructions."
[plushy instructions replacement-rate] [plushy instructions replacement-rate argmap]
(map #(if (< (rand) replacement-rate) (map #(if (< (rand) replacement-rate)
(utils/random-instruction instructions) (utils/random-instruction instructions argmap)
%) %)
plushy)) plushy))
@ -251,7 +251,7 @@ The function `new-individual` returns a new individual produced by selection and
;; 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 argmap)
(uniform-deletion rate))) (uniform-deletion rate)))
; ;
:bmx-umad ;; applies umad to the results of bmx :bmx-umad ;; applies umad to the results of bmx
@ -275,7 +275,7 @@ The function `new-individual` returns a new individual produced by selection and
(bmx plushy1 plushy2 bmx-exchange-rate max-distance argmap)) (bmx plushy1 plushy2 bmx-exchange-rate max-distance argmap))
(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 argmap)
(uniform-deletion umad-rate) (uniform-deletion umad-rate)
(utils/remove-empty-genes) (utils/remove-empty-genes)
(utils/enforce-gene-length-limit (:bmx-gene-length-limit argmap)))) (utils/enforce-gene-length-limit (:bmx-gene-length-limit argmap))))
@ -285,7 +285,8 @@ The function `new-individual` returns a new individual produced by selection and
(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))
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))]
@ -295,18 +296,20 @@ The function `new-individual` returns a new individual produced by selection and
;; 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)) (-> (:plushy (selection/select-parent pop argmap))
(uniform-addition (:instructions argmap) rate) (uniform-addition (:instructions argmap) rate argmap)
(uniform-deletion rate))) (uniform-deletion rate)))
; ;
:uniform-addition :uniform-addition
(-> (:plushy (selection/select-parent pop argmap)) (-> (:plushy (selection/select-parent pop argmap))
(uniform-addition (:instructions argmap) (uniform-addition (:instructions argmap)
(utils/onenum (:umad-rate argmap)))) (utils/onenum (:umad-rate argmap))
argmap))
; ;
:uniform-replacement :uniform-replacement
(-> (:plushy (selection/select-parent pop argmap)) (-> (:plushy (selection/select-parent pop argmap))
(uniform-replacement (:instructions argmap) (uniform-replacement (:instructions argmap)
(utils/onenum (:replacement-rate argmap)))) (utils/onenum (:replacement-rate argmap))
argmap))
; ;
:uniform-deletion :uniform-deletion
(-> (:plushy (selection/select-parent pop argmap)) (-> (:plushy (selection/select-parent pop argmap))