Use Hirschberg's algorithm in diffing

This commit implements Hirschberg's divide-and-conquer algorithm as an
alternative to the LCS table approach. This algorithm uses O(n) space
instead of O(m×n) by computing LCS lengths in both directions and
recursively splitting the problem.  More tests are added to cover
multi-character changes, prefix/suffix optimization, and data structure
comparisons.

Co-Authored-By: Claude Sonnet 4.5 <noreply@anthropic.com>

Author: pyrmont

lib/testament.janet

@@ -152,75 +152,25 @@
      (string/slice s2 0 (- len2 i))
      (string/slice s1 (- len1 i))]))
 
-
-(defn- lcs-table
+(defn- merge-consecutives
   ```
-  Builds LCS table for two strings
+  Merges consecutive segments of the same type
   ```
-  [s1 s2]
-  (def m (length s1))
-  (def n (length s2))
-  (def tbl (array/new-filled (+ m 1) nil))
-  (each i (range 0 (+ m 1))
-    (put tbl i (array/new-filled (+ n 1) 0)))
-  (each i (range 1 (+ m 1))
-    (each j (range 1 (+ n 1))
-      (if (= (get s1 (- i 1)) (get s2 (- j 1)))
-        (put (tbl i) j (+ (get-in tbl [(- i 1) (- j 1)]) 1))
-        (put (tbl i) j (max (get-in tbl [(- i 1) j])
-                            (get-in tbl [i (- j 1)]))))))
-  tbl)
-
-
-(defn- traceback-diff
-  ```
-  Traces back through LCS table to build diff segments
-  ```
-  [tbl s1 s2]
-  (def result @[])
-  (var i (length s1))
-  (var j (length s2))
-  (var stype nil)
-  (var buf @"")
-  (defn flush-segment []
-    (when stype
-      (array/push result @{:type stype
-                           :text (string/reverse buf)})
-      (set buf @"")))
-  (while (or (> i 0) (> j 0))
-    (cond
-      # characters match: record as equal
-      (and (> i 0) (> j 0) (= (get s1 (- i 1)) (get s2 (- j 1))))
-      (do
-        (unless (= :equal stype)
-          (flush-segment)
-          (set stype :equal))
-        (buffer/push-byte buf (get s1 (- i 1)))
-        (-- i)
-        (-- j))
-      # characters only in s2: record as insertion
-      (and (> j 0) (or (zero? i) (>= (get-in tbl [i (- j 1)])
-                                     (get-in tbl [(- i 1) j]))))
-      (do
-        (unless (= :insert stype)
-          (flush-segment)
-          (set stype :insert))
-        (buffer/push-byte buf (get s2 (- j 1)))
-        (-- j))
-      # characters only in s1: record as deletion
+  [segments]
+  (var i 1)
+  (while (def nxt (get segments i))
+    (def cur (get segments (- i 1)))
+    (if (= (cur :type) (nxt :type))
       (do
-        (unless (= stype :delete)
-          (flush-segment)
-          (set stype :delete))
-        (buffer/push-byte buf (get s1 (- i 1)))
-        (-- i))))
-  (flush-segment)
-  (reverse result))
+        (put cur :text (string (cur :text) (nxt :text)))
+        (array/remove segments i))
+      (++ i)))
+  segments)
 
 
-(defn- merge-small-changes
+(defn- merge-islands
   ```
-  Merges small changes for readability
+  Merges isolated equal segments (i.e. islands) for readability
   ```
   [segments]
   (var i 2)
@@ -232,8 +182,7 @@
       (or (= :equal (prv :type))
           (= :equal (nxt :type))
           (not= :equal (cur :type))
-          (string/has-prefix? " " (cur :text))
-          (string/has-suffix? " " (cur :text)))
+          (string/find " " (cur :text)))
       (set i (+ i 1))
       # case 2: prv and nxt different types
       (not= (prv :type) (nxt :type))
@@ -249,40 +198,121 @@
         (put nxt-nxt :text (string (cur :text) (nxt-nxt :text)))
         (array/remove segments (- i 1))
         (set i (+ i 2)))))
-  (set i 1)
-  (while (def nxt (get segments i))
-    (def cur (get segments (- i 1)))
-    (if (= (cur :type) (nxt :type))
-      (do
-        (put cur :text (string (cur :text) (nxt :text)))
-        (array/remove segments i))
-      (++ i)))
-  segments)
+  (merge-consecutives segments))
+
+
+(defn- lcs-lengths
+  ```
+  Computes LCS lengths for last row only (linear space)
+  ```
+  [s1 s2]
+  (def m (length s1))
+  (def n (length s2))
+  (var prv (array/new-filled (+ n 1) 0))
+  (var cur (array/new-filled (+ n 1) 0))
+  (loop [i :range [1 (+ m 1)]]
+    (loop [j :range [1 (+ n 1)]]
+      (if (= (get s1 (- i 1)) (get s2 (- j 1)))
+        (put cur j (+ (get prv (- j 1)) 1))
+        (put cur j (max (get prv j) (get cur (- j 1))))))
+    # swap rows
+    (def tmp prv)
+    (set prv cur)
+    (set cur tmp)
+    (array/fill cur 0))
+  prv)
+
+
+(defn- hirschberg-diff
+  ```
+  Computes diff using Hirschberg's algorithm (linear space)
+  ```
+  [s1 s2]
+  (def m (length s1))
+  (def n (length s2))
+  (cond
+    # Base case: s1 is empty
+    (zero? m)
+    (if (zero? n)
+      @[]
+      @[@{:type :insert :text s2}])
+    # Base case: s2 is empty
+    (zero? n)
+    @[@{:type :delete :text s1}]
+    # Base case: single character in s1
+    (= m 1)
+    (do
+      (def c (get s1 0))
+      (var found nil)
+      (var i 0)
+      (while (and (< i n) (nil? found))
+        (when (= c (get s2 i))
+          (set found i))
+        (++ i))
+      (if found
+        # character found, split s2
+        (let [result @[]]
+          (unless (zero? found)
+            (array/push result @{:type :insert :text (string/slice s2 0 found)}))
+          (array/push result @{:type :equal :text (string/from-bytes c)})
+          (unless (= found (- n 1))
+            (array/push result @{:type :insert :text (string/slice s2 (+ found 1))}))
+          result)
+        # not found, delete s1 and insert s2
+        @[@{:type :delete :text s1}
+          @{:type :insert :text s2}]))
+    # Recursive case: divide and conquer
+    (let [mid (math/floor (/ m 2))
+          s1-left (string/slice s1 0 mid)
+          s1-right (string/slice s1 mid)
+          # compute LCS lengths from left
+          left-lens (lcs-lengths s1-left s2)
+          # compute LCS lengths from right (reversed)
+          right-lens (lcs-lengths (string/reverse s1-right)
+                                  (string/reverse s2))
+          # find optimal split point in s2
+          split-point (do
+                        (var best-j 0)
+                        (var best-len (+ (get left-lens 0)
+                                         (get right-lens n)))
+                        (loop [j :range [1 (+ n 1)]]
+                          (def total (+ (get left-lens j)
+                                        (get right-lens (- n j))))
+                          (when (> total best-len)
+                            (set best-len total)
+                            (set best-j j)))
+                        best-j)
+          s2-left (string/slice s2 0 split-point)
+          s2-right (string/slice s2 split-point)
+          # Recursively solve left and right halves
+          left-diff (hirschberg-diff s1-left s2-left)
+          right-diff (hirschberg-diff s1-right s2-right)]
+      # Merge results and consolidate consecutive same-type segments
+      (merge-consecutives (array/concat left-diff right-diff)))))
 
 
 (defn- compute-diff
   ```
   Computes byte-level diff between two strings with prefix/suffix optimization
   ```
   [s1 s2]
+  # separate prefix and suffix as optimisation
   (def [prefix s1-mid s2-mid] (strip-common-prefix s1 s2))
   (def [s1-core s2-core suffix] (strip-common-suffix s1-mid s2-mid))
-
+  # compare core difference
   (def diff-core
     (if (and (empty? s1-core) (empty? s2-core))
       @[]
-      (let [tbl (lcs-table s1-core s2-core)]
-        (traceback-diff tbl s1-core s2-core))))
-
+      (hirschberg-diff s1-core s2-core)))
+  # glue back together
   (def result @[])
   (unless (empty? prefix)
     (array/push result {:type :equal :text prefix}))
-  (each segment diff-core
-    (array/push result segment))
+  (array/concat result diff-core)
   (unless (empty? suffix)
     (array/push result {:type :equal :text suffix}))
-
-  (merge-small-changes result))
+  # merge small, isolated equal segments
+  (merge-islands result))
 
 
 (defn- render-diff-line
@@ -350,8 +380,7 @@
     :equal
     (let [expect-str (string/format "%q" (result :expect))
           actual-str (string/format "%q" (result :actual))]
-      (if (and (dyn :test/color?)
-               (< (+ (length expect-str) (length actual-str)) 2000))
+      (if (dyn :test/color?)
         (format-with-diff expect-str actual-str)
         (string "Expect (L): " expect-str "\n"
                 "Actual (R): " actual-str)))

test/testament.janet

@@ -429,7 +429,7 @@
 
 (t/reset-all!)
 
-# Test diff functionality (integration tests)
+# Test diff functionality
 
 (defn test-diff-with-color []
   (t/deftest test-with-diff
@@ -469,7 +469,7 @@
 
 (t/reset-all!)
 
-(defn test-diff-long-string-fallback []
+(defn test-diff-long-string []
   (def long-str1 (string/repeat "x" 1001))
   (def long-str2 (string/repeat "y" 1001))
   (t/deftest test-long-diff
@@ -481,12 +481,88 @@
       (string "-----------------------------------\n"
               "> \e[31mFailed\e[0m: test-long-diff\n"
               "Assertion: (= long-str1 long-str2)\n"
-              "Expect (L): " (string/format "%q" long-str1) "\n"
-              "Actual (R): " (string/format "%q" long-str2) "\n"))
+              "Expect (L): \"\e[48;5;52m" long-str1 "\e[0m\"\n"
+              "Actual (R): \"\e[48;5;22m" long-str2 "\e[0m\"\n"))
     (unless (= expect (string output))
       (error "Test failed"))))
 
-(test-diff-long-string-fallback)
+(test-diff-long-string)
+
+
+(t/reset-all!)
+
+(defn test-diff-multi-char []
+  (t/deftest test-multi-diff
+    (t/assert-equal "The quick brown fox" "The quirk brawn fox"))
+  (let [output @""]
+    (with-dyns [:out output :test/color? true]
+      (test-multi-diff))
+    (def expect (string "-----------------------------------\n"
+                        "> \e[31mFailed\e[0m: test-multi-diff\n"
+                        "Assertion: (= \"The quick brown fox\" \"The quirk brawn fox\")\n"
+                        "Expect (L): \"The qui\e[48;5;52mc\e[0mk br\e[48;5;52mo\e[0mwn fox\"\n"
+                        "Actual (R): \"The qui\e[48;5;22mr\e[0mk br\e[48;5;22ma\e[0mwn fox\"\n"))
+    (unless (= expect (string output))
+      (error "Test failed"))))
+
+(test-diff-multi-char)
+
+
+(t/reset-all!)
+
+(defn test-diff-prefix-suffix []
+  (t/deftest test-prefix-suffix
+    (t/assert-equal "xxxxxxxxAyyyyyyyy" "xxxxxxxxByyyyyyyy"))
+  (let [output @""]
+    (with-dyns [:out output :test/color? true]
+      (test-prefix-suffix))
+    (def expect (string "-----------------------------------\n"
+                        "> \e[31mFailed\e[0m: test-prefix-suffix\n"
+                        "Assertion: (= \"xxxxxxxxAyyyyyyyy\" \"xxxxxxxxByyyyyyyy\")\n"
+                        "Expect (L): \"xxxxxxxx\e[48;5;52mA\e[0myyyyyyyy\"\n"
+                        "Actual (R): \"xxxxxxxx\e[48;5;22mB\e[0myyyyyyyy\"\n"))
+    (unless (= expect (string output))
+      (error "Test failed"))))
+
+(test-diff-prefix-suffix)
+
+
+(t/reset-all!)
+
+(defn test-diff-multiple-changes []
+  (t/deftest test-multiple
+    (t/assert-equal "Julia is great" "Janet is awesome"))
+  (let [output @""]
+    (with-dyns [:out output :test/color? true]
+      (test-multiple))
+    (def expect (string "-----------------------------------\n"
+                        "> \e[31mFailed\e[0m: test-multiple\n"
+                        "Assertion: (= \"Julia is great\" \"Janet is awesome\")\n"
+                        "Expect (L): \"J\e[48;5;52mulia\e[0m is \e[48;5;52mgreat\e[0m\"\n"
+                        "Actual (R): \"J\e[48;5;22manet\e[0m is \e[48;5;22mawesome\e[0m\"\n"))
+    (unless (= expect (string output))
+      (error "Test failed"))))
+
+(test-diff-multiple-changes)
+
+
+(t/reset-all!)
+
+(defn test-diff-structures []
+  (t/deftest test-structures
+    (t/assert-equal [1 2 3] [1 3 3]))
+  (let [output @""]
+    (with-dyns [:out output :test/color? true]
+      (test-structures))
+    (def expect (string "-----------------------------------\n"
+                        "> \e[31mFailed\e[0m: test-structures\n"
+                        "Assertion: (= [1 2 3] [1 3 3])\n"
+                        "Expect (L): (1 \e[48;5;52m2\e[0m 3)\n"
+                        "Actual (R): (1 \e[48;5;22m3\e[0m 3)\n"))
+    (unless (= expect (string output))
+      (error "Test failed"))))
+
+(test-diff-structures)
 
 
 (t/reset-all!)