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

Remove autoconstructive hypervariability mutation (ah-umad)

Browse Source
This commit is contained in:
Lee Spector 2023-11-30 18:37:33 -05:00
parent 5c127ef21b
commit b6e506f4bd
4 changed files with 4 additions and 106 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
src/propeller/genome.cljc
View File

@ -48,9 +48,8 @@ They hold the genetic material for an `individual`. In the initial population, w
(plushy->push plushy {}))
;; call plushy->push-internal with possibly-preprocessed plushy
([plushy argmap]
(plushy->push-internal (if (or (> (or (:ah-umad (:variation argmap)) 0) 0) ;; must strip :vary and :protect
(> (or (:bmx (:variation argmap)) 0) 0) ;; must strip :gene
(plushy->push-internal (if (or (> (or (:bmx (:variation argmap)) 0) 0) ;; must strip :gene
(> (or (:bmx-umad (:variation argmap)) 0) 0)) ;; must strip :gene
(filter (complement #{:vary :protect :gene}) plushy)
(filter (complement #{:gene}) plushy)
plushy)
argmap)))

11
src/propeller/gp.cljc
View File

@ -185,15 +185,6 @@
(if (or (and prob-bmx (> prob-bmx 0))
(and prob-bmx-umad (> prob-bmx-umad 0)))
(update args :instructions concat (repeat (or n 1) :gene))
args)))
;
adjust-for-ah-umad
(fn [args]
(let [prob (:ah-umad (:variation args))
n (:ah-umad-enrichment args)]
(if (and prob (> prob 0))
(update args :instructions concat (flatten (repeat (or n 1) [:vary :protect])))
args)))]
(gp-loop (-> argmap
(adjust-for-bmx)
(adjust-for-ah-umad)))))
(adjust-for-bmx)))))

6
src/propeller/problems/boolean/mul3.cljc
View File

@ -307,11 +307,7 @@
:ds-function :case-rand
:downsample-rate 0.1
:umad-rate 0.01
:ah-umad-min 0.001
:ah-umad-max 0.5
:ah-umad-mean 0.01
:variation {:ah-umad 0
:umad 0
:variation {:umad 0
:bmx 0
:bmx-umad 1}
:single-thread-mode false

88
src/propeller/variation.cljc
View File

@ -134,85 +134,6 @@ The function `new-individual` returns a new individual produced by selection and
(/ 1 (+ 1 (/ 1 umad-rate)))))
plushy)))
(defn ah-normalize
"A utility for autoconstructive hypervariability mutation.
Takes a vector of :protect and :vary and returns a numeric vector
that conforms to the specified min, max, and mean."
[v ah-min ah-max ah-mean]
(let [c (count v)
protect-count (count (filter #(= % :protected) v))
vary-count (- c protect-count)
extremes (mapv #(if (= % :protect) ah-min ah-max) v)
mean-of-extremes (/ (reduce + extremes) (count extremes))]
(cond
;; all :vary or all :protect, return all ah-mean
(or (zero? protect-count) (zero? vary-count))
(repeat (count v) ah-mean)
;; mean is too high, lower high values from max
(> mean-of-extremes ah-mean)
(let [lowered (/ (- (* ah-mean c)
(* ah-min protect-count))
vary-count)]
(mapv #(if (= % ah-max) lowered %) extremes))
;; mean is too low, raise low values from min
(> mean-of-extremes ah-mean)
(let [raised (/ (- (* ah-mean c)
(* ah-max vary-count))
protect-count)]
(mapv #(if (= % ah-min) raised %) extremes))
;; mean is just right, return extremes
:else
extremes)))
(defn ah-rates
"A utility for autoconstructive hypervariability mutation.
Returns the sequence of rates with which each element of plushy should
be mutated when using autoconstructive hypervariability."
[plushy ah-min ah-max ah-mean]
(loop [i 0
protected true
rates []
remainder plushy]
(if (empty? remainder)
(ah-normalize rates ah-min ah-max ah-mean)
(if (and (not protected)
(= (first remainder) :protect))
(recur (inc i)
true
(conj rates 1)
(rest remainder))
(recur (inc i)
(if protected
(not= (first remainder) :vary)
false)
(conj rates (if protected :protect :vary))
(rest remainder))))))
(defn ah-uniform-addition
"Returns plushy with new instructions possibly added before or after each
existing instruction. Rates are autoconstructively hypervariable."
[plushy instructions ah-min ah-max ah-mean]
(apply concat
(mapv #(if (< (rand) %2)
(shuffle [%1 (utils/random-instruction instructions)])
[%1])
plushy
(ah-rates plushy ah-min ah-max ah-mean))))
(defn ah-uniform-deletion
"Randomly deletes instructions from plushy at some rate.
Rates are autoconstructively hypervariable."
[plushy ah-min ah-max ah-mean]
(mapv first
(remove (fn [[_ rate]]
(< (rand)
(if (zero? rate)
0
(/ 1 (+ 1 (/ 1 rate))))))
(mapv vector
plushy
(ah-rates plushy ah-min ah-max ah-mean)))))
(defn bmx
"Crosses over two plushies using best match crossover (bmx)."
[plushy-a plushy-b rate]
@ -290,15 +211,6 @@ The function `new-individual` returns a new individual produced by selection and
(-> (:plushy (selection/select-parent pop argmap))
(uniform-addition (:instructions argmap) rate)
(uniform-deletion rate)))
;
:ah-umad ;; autoconstructive hypervariability UMAD
(let [ah-min (utils/onenum (:ah-umad-min argmap))
ah-max (utils/onenum (:ah-umad-max argmap))
ah-mean (utils/onenum (:ah-umad-mean argmap))
parent-genome (:plushy (selection/select-parent pop argmap))]
(-> parent-genome
(ah-uniform-addition (:instructions argmap) ah-min ah-max ah-mean)
(ah-uniform-deletion ah-min ah-max ah-mean)))
;
:uniform-addition
(-> (:plushy (selection/select-parent pop argmap))