Reformulate rate normalization for autoconstruction hypervariability

This commit is contained in:
Lee Spector 2023-10-29 00:25:20 -04:00
parent cfbba8cbc4
commit a8045357fd
2 changed files with 44 additions and 20 deletions

View File

@ -315,8 +315,9 @@
;:max-batch-size [1 2 4 8 16 32 64 128 256]
;:tournament-size 5
;:umad-rate 0.09
:ah-umad-protection 10 ;; ah-umad
:ah-umad-rate 0.1 ;; ah-umad
:ah-umad-min 0.01
:ah-umad-max 0.5
:ah-umad-mean 0.05
;:umad-rate [1/2
; 1/4 1/4
; 1/8 1/8 1/8

View File

@ -202,24 +202,46 @@ The function `new-individual` returns a new individual produced by selection and
%)
(partition 2 plushy))))
(defn with-mean
"Returns numeric vector v scaled so that the mean value is m"
[m v]
(if (empty? v)
v
(let [initial-mean (/ (reduce + v) (count v))]
(map #(* m (/ % initial-mean)) v))))
(defn ah-normalize
"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
"Returns the sequence of rates with which each element of plushy should
be mutated when using autoconstructive hypervariability."
[plushy protection rate]
[plushy ah-min ah-max ah-mean]
(loop [i 0
protected true
rates []
remainder plushy]
(if (empty? remainder)
(with-mean rate rates)
(ah-normalize rates ah-min ah-max ah-mean)
(if (and (not protected)
(= (first remainder) :protect))
(recur i
@ -230,24 +252,24 @@ The function `new-individual` returns a new individual produced by selection and
(if protected
(not= (first remainder) :vary)
false)
(conj rates (if protected (/ 1 protection) 1))
(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 protection rate]
[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 protection rate))))
(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 protection rate]
[plushy ah-min ah-max ah-mean]
(mapv first
(remove (fn [[_ rate]]
(< (rand)
@ -256,7 +278,7 @@ The function `new-individual` returns a new individual produced by selection and
(/ 1 (+ 1 (/ 1 rate))))))
(mapv vector
plushy
(ah-rates plushy protection rate)))))
(ah-rates plushy ah-min ah-max ah-mean)))))
(defn new-individual
"Returns a new individual produced by selection and variation of
@ -313,12 +335,13 @@ The function `new-individual` returns a new individual produced by selection and
(uniform-deletion rate)))
;
:ah-umad ;; autoconstructive hypervariability UMAD
(let [protection (utils/onenum (:ah-umad-protection argmap))
rate (utils/onenum (:ah-umad-rate argmap))
(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) protection rate)
(ah-uniform-deletion protection rate)))
(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))