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

Reformulate bmx distance and remove distance limit

Browse Source
This commit is contained in:
Lee Spector 2023-12-10 20:18:05 -05:00
parent a706babff1
commit 435eb59371
2 changed files with 15 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/propeller/tools/metrics.cljc
View File

@ -137,11 +137,3 @@
(math/abs (- (count (filter (partial = (first remaining)) ms1))
(count (filter (partial = (first remaining)) ms2)))))
(rest remaining)))))
(defn unigram-bigram-distance
"Returns the distance between two sequences, calculated as the sum of the multiset
distance between the items (unigrams) in the sequences and half of the multiset
distance between the adjacent pairs (bigrams) in the sequences."
[seq1 seq2]
(+ (multiset-distance seq1 seq2)
(* 0.5 (multiset-distance (partition 2 1 seq1) (partition 2 1 seq2)))))

28
src/propeller/variation.cljc
View File

@ -53,7 +53,8 @@ The function `new-individual` returns a new individual produced by selection and
{:doc/format :markdown}
(:require [propeller.selection :as selection]
[propeller.utils :as utils]
[propeller.tools.metrics :as metrics]))
[propeller.tools.metrics :as metrics]
[propeller.tools.math :as math]))
(defn crossover
"Crosses over two individuals using uniform crossover, one Push instruction at a time.
@ -165,27 +166,24 @@ The function `new-individual` returns a new individual produced by selection and
(< (rand) adjusted-rate)))
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 bmx
"Crosses over two plushies using best match crossover (bmx)."
[plushy-a plushy-b rate]
(let [a-genes (utils/extract-genes plushy-a)
b-genes (utils/extract-genes plushy-b)]
(flatten
(interpose
:gap
(mapv (fn [a-gene]
(interpose :gap
(mapv (fn [g]
(if (< (rand) rate)
(let [match-info (map (fn [b-gene]
{:distance (metrics/unigram-bigram-distance a-gene b-gene)
:gene b-gene})
b-genes)
candidates (filter (fn [info]
(<= (:distance info) 4))
match-info)]
(if (empty? candidates)
a-gene
(:gene (apply min-key :distance candidates))))
a-gene))
(apply min-key #(bmx-distance g %) b-genes)
g))
a-genes)))))
(defn new-individual