From 45afa1a5ddc609d9cbfaeba8fc8fd353a9191e43 Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Tue, 10 Apr 2007 07:42:18 +0000
Subject: `diff': Included Aubrey Jaffer's fix for `diff:edits'.

* src/guile/diff.scm: Updated from Aubrey Jaffer's latest upstream
  version which includes a fix for bug in `diff:edits' that showed up in
  `(diff:edits "Conclusion" "Related Work")' (SLIB changes dated
  2007-04-07).

git-archimport-id: lcourtes@laas.fr--2006-libre/skribilo--devo--1.2--patch-49
---
 src/guile/diff.scm | 46 ++++++++++++++++++++++------------------------
 1 file changed, 22 insertions(+), 24 deletions(-)

(limited to 'src/guile')

diff --git a/src/guile/diff.scm b/src/guile/diff.scm
index 5082557..88cdd58 100644
--- a/src/guile/diff.scm
+++ b/src/guile/diff.scm
@@ -1,5 +1,5 @@
 ;;; "differ.scm" O(NP) Sequence Comparison Algorithm.
-;;; Copyright (C) 2001, 2002, 2003, 2004 Aubrey Jaffer
+;;; Copyright (C) 2001, 2002, 2003, 2004, 2007 Aubrey Jaffer
 
 ;;;
 ;;; Taken from Slib 3a2 and adapated by Ludovic Courtès
@@ -196,11 +196,10 @@
     (let ((b-splt (diff:mid-split len-b RR CC tcst)))
       (define est-c (array-ref CC b-splt))
       (define est-r (array-ref RR (- len-b b-splt)))
-      ;;(set! splts (cons (/ b-splt (max .1 len-b)) splts))
-      ;;(display "A: ") (array-for-each display (fp:subarray A start-a mid-a)) (display " + ") (array-for-each display (fp:subarray A mid-a end-a)) (newline)
-      ;;(display "B: ") (array-for-each display (fp:subarray B start-b end-b)) (newline)
+      ;;(display "A:     ") (array-for-each display (fp:subarray A start-a mid-a)) (display " + ") (array-for-each display (fp:subarray A mid-a end-a)) (newline)
+      ;;(display "B:     ") (array-for-each display (fp:subarray B start-b end-b)) (newline)
       ;;(print 'cc cc) (print 'rr (fp:subarray RR (+ 1 len-b) 0))
-      ;;(print (make-string (+ 7 (* 2 b-splt)) #\-) '^  (list b-splt))
+      ;;(print (make-string (+ 12 (* 2 b-splt)) #\-) '^  (list b-splt))
       (check-cost! 'CC est-c
 		  (diff2et fp fpoff CCRR
 			   A start-a mid-a
@@ -384,24 +383,23 @@
 (define (diff:edits A B . p-lim)
   (define M (car (array-dimensions A)))
   (define N (car (array-dimensions B)))
-  (set! p-lim (if (null? p-lim) -1 (car p-lim)))
-  (let ((fp (make-typed-array 's32 0
-                              (if (negative? p-lim)
-                                  (+ 3 M N)
-                                  (+ 3 (abs (- N M)) p-lim p-lim)))))
-    (define est (if (< N M)
-		    (diff2editlen fp B A p-lim)
-		    (diff2editlen fp A B p-lim)))
-    (and est
-	 (let ((edits (make-typed-array 's32 0 est))
-	       (CCRR (make-typed-array 's32 0 (* 2 (+ (max M N) 1)))))
-	   (cond ((< N M)
-		  (diff2edits! edits fp CCRR B A)
-		  (diff:invert-edits! edits))
-		 (else
-		  (diff2edits! edits fp CCRR A B)))
-	   ;;(diff:order-edits! edits est)
-	   edits))))
+  (define est (diff:edit-length A B (if (null? p-lim) -1 (car p-lim))))
+  (and est
+       (let ((CCRR (make-typed-array 's32 0
+                                     (* 2 (+ (max M N) 1))))
+	     (edits (make-typed-array 's32 0 est)))
+	 (define fp (make-typed-array 's32 0
+                                      (+ (max (- N (quotient M 2))
+                                              (- M (quotient N 2)))
+                                         (- est (abs (- N M))) ; 2 * p-lim
+                                         3)))
+	 (cond ((< N M)
+		(diff2edits! edits fp CCRR B A)
+		(diff:invert-edits! edits))
+	       (else
+		(diff2edits! edits fp CCRR A B)))
+	 ;;(diff:order-edits! edits est)
+	 edits)))
 
 ;;@args array1 array2 p-lim
 ;;@args array1 array2
@@ -437,7 +435,7 @@
 ;;       ; e  c  h p q  r
 ;;@end example
 
-;;(trace-all "/home/jaffer/slib/differ.scm")(set! *qp-width* 333)(untrace fp:run fp:subarray)
+;;(trace-all "/home/jaffer/slib/differ.scm")(set! *qp-width* 999)(untrace fp:run fp:subarray)
 
 
 ;;;arch-tag: 8e80eb1d-fb11-4872-895a-8adcee26580d
-- 
cgit v1.2.3