Implement autoconstructive hypervariation umad (ah-umad)

src/propeller/variation.cljc

@@ -202,6 +202,52 @@ The function `new-individual` returns a new individual produced by selection and
                    %)
                 (partition 2 plushy))))
 
+(defn ah-rates
+  [plushy protect-rate hypervariable-rate]
+  (loop [i 0
+         protected true
+         rates []
+         remainder plushy]
+    (if (empty? remainder)
+      rates
+      (if (and (not protected)
+               (= (first remainder) :protect))
+        (recur i
+               true
+               rates
+               remainder)
+        (recur (inc i)
+               (if protected
+                 (not= (first remainder) :vary)
+                 false)
+               (conj rates (if protected protect-rate hypervariable-rate))
+               (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 protect-rate hypervariable-rate]
+  (apply concat
+         (map #(if (< (rand) %2)
+                 (shuffle [%1 (utils/random-instruction instructions)])
+                 [%1])
+              plushy
+              (ah-rates plushy protect-rate hypervariable-rate))))
+
+(defn ah-uniform-deletion
+  "Randomly deletes instructions from plushy at some rate.
+   Rates are autoconstructively hypervariable."
+  [plushy protect-rate hypervariable-rate]
+  (map first
+       (remove (fn [[_ rate]]
+                 (< (rand)
+                    (if (zero? rate)
+                      0
+                      (/ 1 (+ 1 (/ 1 rate))))))
+               (map vector
+                    plushy
+                    (ah-rates plushy protect-rate hypervariable-rate)))))
+
 (defn new-individual
   "Returns a new individual produced by selection and variation of
   individuals in the population."
@@ -254,6 +300,13 @@ The function `new-individual` returns a new individual produced by selection and
              (uniform-addition (:instructions argmap) rate)
              (uniform-deletion rate)))
        ;
+       :ah-umad
+       (let [rate (utils/onenum (:umad-rate argmap))
+             ah-rate (utils/onenum (:ah-umad-rate argmap))]
+         (-> (:plushy (selection/select-parent pop argmap))
+             (ah-uniform-addition (:instructions argmap) rate ah-rate)
+             (ah-uniform-deletion rate ah-rate)))
+       ;
        :uniform-addition
        (-> (:plushy (selection/select-parent pop argmap))
            (uniform-addition (:instructions argmap)