Move more bmx utility functions to utils namespace

This commit is contained in:
Lee Spector 2023-12-26 14:33:12 -05:00
parent 1eafd17b5f
commit c3a748e5cc
2 changed files with 26 additions and 24 deletions

View File

@ -1,7 +1,9 @@
(ns propeller.utils (ns propeller.utils
"Useful functions." "Useful functions."
(:require [clojure.zip :as zip] (:require [clojure.zip :as zip]
[clojure.repl :as repl])) [clojure.repl :as repl]
[propeller.tools.metrics :as metrics]
[propeller.tools.math :as math]))
(defn filter-by-index (defn filter-by-index
"filters a collection by a list of indices" "filters a collection by a list of indices"
@ -188,3 +190,22 @@
(recur genes (recur genes
(conj current-gene (first remainder)) (conj current-gene (first remainder))
(rest remainder))))) (rest remainder)))))
(defn bmx-distance
"A utility function for bmx. Returns the distance between two plushies
computed as half of their multiset-distance plus their length difference."
[p1 p2]
(+ (* 0.5 (metrics/multiset-distance p1 p2))
(math/abs (- (count p1) (count p2)))))
(defn fill-empty-genes
"A utility function for bmx-related genetic operators. Returns the provided
plushy with any empty genes (regions before/between/after instances of :gap)
filled with a new random instruction."
[plushy instructions]
(flatten (interpose :gap
(mapv (fn [gene]
(if (empty? gene)
(random-instruction instructions)
gene))
(extract-genes plushy)))))

View File

@ -166,25 +166,6 @@ The function `new-individual` returns a new individual produced by selection and
(< (rand) adjusted-rate))) (< (rand) adjusted-rate)))
plushy)))) plushy))))
(defn bmx-distance
"A utility function for bmx. Returns the distance between two plushies
computed as half of their multiset-distance plus their length difference."
[p1 p2]
(+ (* 0.5 (metrics/multiset-distance p1 p2))
(math/abs (- (count p1) (count p2)))))
(defn fill-empty-genes
"A utility function for bmx-related genetic operators. Returns the provided
plushy with any empty genes (regions before/between/after instances of :gap)
filled with a new random instruction."
[plushy instructions]
(flatten (interpose :gap
(mapv (fn [gene]
(if (empty? gene)
(utils/random-instruction instructions)
gene))
(utils/extract-genes plushy)))))
(defn bmx (defn bmx
"Crosses over two plushies using best match crossover (bmx)." "Crosses over two plushies using best match crossover (bmx)."
[plushy-a plushy-b rate max-distance argmap] [plushy-a plushy-b rate max-distance argmap]
@ -204,7 +185,7 @@ The function `new-individual` returns a new individual produced by selection and
(mapv (fn [a-gene] (mapv (fn [a-gene]
(if (< (rand) rate) (if (< (rand) rate)
(let [match-info (map (fn [b-gene] (let [match-info (map (fn [b-gene]
{:distance (bmx-distance a-gene b-gene) {:distance (utils/bmx-distance a-gene b-gene)
:gene b-gene}) :gene b-gene})
b-genes) b-genes)
candidates (filter (fn [info] candidates (filter (fn [info]
@ -263,7 +244,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)
(fill-empty-genes (:instructions argmap)))) (utils/fill-empty-genes (:instructions argmap))))
; ;
: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
@ -295,7 +276,7 @@ The function `new-individual` returns a new individual produced by selection and
(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)
(fill-empty-genes (:instructions argmap)))) (utils/fill-empty-genes (:instructions argmap))))
; ;
: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