Move more bmx utility functions to utils namespace
This commit is contained in:
parent
1eafd17b5f
commit
c3a748e5cc
@ -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)))))
|
||||||
|
@ -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
|
||||||
|
Loading…
x
Reference in New Issue
Block a user