Compute lcs-length and edit-distance with Myers' O(ND) algorithm

diff.carp

@@ -115,21 +115,40 @@
           (Deletion xs) (push-all! &res xs)))
       res))
 
+  ; length of the shortest edit script, by Myers' greedy O(ND) algorithm (1986)
+  (defn- ses-length [old new]
+    (let-do [n (Array.length old)
+             m (Array.length new)
+             off (inc (+ n m))
+             v (Array.replicate (inc (* 2 off)) &0)
+             d -1
+             done false]
+      (while-do (not done)
+        (set! d (inc d))
+        (for [k (max (neg d) (- d (* 2 m))) (inc (min d (- (* 2 n) d))) 2]
+          (let-do [x (if (or (= k (neg d))
+                             (and (/= k d)
+                                  (< @(Array.unsafe-nth &v (+ off (dec k)))
+                                     @(Array.unsafe-nth &v (+ off (inc k))))))
+                     @(Array.unsafe-nth &v (+ off (inc k)))
+                     (inc @(Array.unsafe-nth &v (+ off (dec k)))))]
+            (while (and (< x n)
+                        (< (- x k) m)
+                        (= (Array.unsafe-nth old x)
+                           (Array.unsafe-nth new (- x k))))
+              (set! x (inc x)))
+            (Array.aset! &v (+ off k) x)
+            (when-do (and (>= x n) (>= (- x k) m)) (set! done true) (break)))))
+      d))
+
   (doc lcs-length
     "Returns the length of the longest common subsequence of two arrays.")
   (defn lcs-length [old new]
-    (let-do [d &(diff old new)
-             len 0]
-      (for [i 0 (Array.length d)]
-        (match-ref (Array.unsafe-nth d i)
-          (Eq xs) (set! len (+ len (Array.length xs)))
-          _ ()))
-      len))
+    (/ (- (+ (Array.length old) (Array.length new)) (ses-length old new)) 2))
 
   (doc edit-distance
     "Returns the edit distance (number of insertions plus deletions) between two arrays.")
-  (defn edit-distance [old new]
-    (- (+ (Array.length old) (Array.length new)) (* 2 (lcs-length old new))))
+  (defn edit-distance [old new] (ses-length old new))
 
   (doc similarity
     "Returns a similarity ratio between 0.0 and 1.0 for two arrays, based on their longest common subsequence. Two empty arrays have similarity 1.0.")

tests/diff.carp

@@ -270,6 +270,26 @@ KK")) "unified generates multiple hunks for distant changes")
       2
       (Diff.lcs-length &[1 2] &[1 2 3 4])
       "lcs-length when one is prefix of other")
+    (assert-equal test
+      0
+      (Diff.lcs-length &[1 2 3] &[])
+      "lcs-length with an empty new array is 0")
+    (assert-equal test
+      1
+      (Diff.lcs-length &[5] &[5])
+      "lcs-length of equal single elements is 1")
+    (assert-equal test
+      0
+      (Diff.lcs-length &[5] &[6])
+      "lcs-length of different single elements is 0")
+    (assert-equal test
+      3
+      (Diff.lcs-length &[1 3 5] &[1 2 3 4 5])
+      "lcs-length when old is a subsequence of new")
+    (assert-equal test
+      2
+      (Diff.lcs-length &[1 2 3 4 5] &[2 4])
+      "lcs-length when new is a subsequence of old")
 
     (assert-equal test
       0
@@ -295,6 +315,26 @@ KK")) "unified generates multiple hunks for distant changes")
       2
       (Diff.edit-distance &[1 2] &[1 2 3 4])
       "edit-distance when one is prefix of other")
+    (assert-equal test
+      3
+      (Diff.edit-distance &[1 2 3] &[])
+      "edit-distance with an empty new array")
+    (assert-equal test
+      0
+      (Diff.edit-distance &[5] &[5])
+      "edit-distance of equal single elements is 0")
+    (assert-equal test
+      2
+      (Diff.edit-distance &[5] &[6])
+      "edit-distance of different single elements is 2")
+    (assert-equal test
+      2
+      (Diff.edit-distance &[1 3 5] &[1 2 3 4 5])
+      "edit-distance when old is a subsequence of new")
+    (assert-equal test
+      3
+      (Diff.edit-distance &[1 2 3 4 5] &[2 4])
+      "edit-distance when new is a subsequence of old")
 
     (assert-equal test
       1.0
@@ -312,6 +352,40 @@ KK")) "unified generates multiple hunks for distant changes")
       0.0
       (Diff.similarity &[] &[1 2 3])
       "similarity with one empty array is 0.0")
+    (assert-equal test
+      0.75
+      (Diff.similarity &[1 3 5] &[1 2 3 4 5])
+      "similarity when one is a subsequence of the other")
+
+    ; inputs where the Eq hunks of diff are not a longest common subsequence
+    (assert-equal test
+      2
+      (Diff.lcs-length &[1 2 3] &[3 1 3])
+      "lcs-length with an out-of-order shared element")
+    (assert-equal test
+      2
+      (Diff.edit-distance &[1 2 3] &[3 1 3])
+      "edit-distance with an out-of-order shared element")
+    (assert-equal test
+      3
+      (Diff.lcs-length &[1 1 1] &[1 2 1 1])
+      "lcs-length with a repeated element")
+    (assert-equal test
+      1
+      (Diff.edit-distance &[1 1 1] &[1 2 1 1])
+      "edit-distance with a repeated element")
+    (assert-equal test
+      5
+      (Diff.lcs-length &[3 1 2 1 3 2] &[3 2 1 2 3 2])
+      "lcs-length of interleaved arrays")
+    (assert-equal test
+      2
+      (Diff.edit-distance &[3 1 2 1 3 2] &[3 2 1 2 3 2])
+      "edit-distance of interleaved arrays")
+    (assert-equal test
+      0.5
+      (Diff.similarity &[1 2] &[2 1 1 1 3 2])
+      "similarity counts every element of the LCS")
 
     ; str/prn
     (assert-equal test