Reformulate bmx distance and remove distance limit

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

View File

@ -137,11 +137,3 @@
(math/abs (- (count (filter (partial = (first remaining)) ms1)) (math/abs (- (count (filter (partial = (first remaining)) ms1))
(count (filter (partial = (first remaining)) ms2))))) (count (filter (partial = (first remaining)) ms2)))))
(rest remaining))))) (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)))))

View File

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