Reformulate bmx distance and remove distance limit

lspector · Dec 11, 2023 · 435eb59 · 435eb59
1 parent a706bab
commit 435eb59
Show file tree

Hide file tree

Showing 2 changed files with 15 additions and 25 deletions.
diff --git a/src/propeller/tools/metrics.cljc b/src/propeller/tools/metrics.cljc
@@ -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)))))
diff --git a/src/propeller/variation.cljc b/src/propeller/variation.cljc
@@ -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,28 +166,25 @@ 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]
-              (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))
-            a-genes)))))
+     (interpose :gap
+                (mapv (fn [g]
+                        (if (< (rand) rate)
+                          (apply min-key #(bmx-distance g %) b-genes)
+                          g))
+                      a-genes)))))
 
 (defn new-individual
   "Returns a new individual produced by selection and variation of