Import Upstream version 3a2upstream/3a2

1 files changed, 159 insertions, 172 deletions

diff --git a/differ.scm b/differ.scm
index 23b0e91..6acc253 100644
--- a/differ.scm
+++ b/differ.scm
@@ -1,5 +1,5 @@
 ;;;; "differ.scm" O(NP) Sequence Comparison Algorithm.
-;;; Copyright (C) 2001, 2002, 2003 Aubrey Jaffer
+;;; Copyright (C) 2001, 2002, 2003, 2004 Aubrey Jaffer
 ;
 ;Permission to copy this software, to modify it, to redistribute it,
 ;to distribute modified versions, and to use it for any purpose is
@@ -25,14 +25,14 @@
 ;;S. Wu, E. Myers, U. Manber, and W. Miller,
 ;;   "An O(NP) Sequence Comparison Algorithm,"
 ;;   Information Processing Letters 35, 6 (1990), 317-323.
-;;   @url{http://www.cs.arizona.edu/people/gene/vita.html}
+;;   @url{http://www.cs.arizona.edu/people/gene/PAPERS/np_diff.ps}
 ;;@end example
 ;;@end ifinfo
 ;;@ifset html
 ;;S. Wu, <A HREF="http://www.cs.arizona.edu/people/gene/vita.html">
 ;;E. Myers,</A> U. Manber, and W. Miller,
 ;;<A HREF="http://www.cs.arizona.edu/people/gene/PAPERS/np_diff.ps">
-;;"An O(NP) Sequence Comparison Algorithm,"</A>
+;;"An O(NP) Sequence Comparison Algorithm"</A>,
 ;;Information Processing Letters 35, 6 (1990), 317-323.
 ;;@end ifset
 ;;
@@ -41,12 +41,24 @@
 ;;the degree of match between two sequences.
 ;;
 ;;@noindent
-;;Surprisingly, "An O(NP) Sequence Comparison Algorithm" does not
-;;derive the edit sequence; only the sequence length.  Developing this
-;;linear-space sub-quadratic-time algorithm for computing the edit
-;;sequence required hundreds of hours of work.  I have submitted a
-;;paper describing the algorithm to the Journal of Computational
-;;Biology.
+;;@code{diff:edits} and @code{diff:longest-common-subsequence} combine
+;;the algorithm with the divide-and-conquer method outlined in:
+;;
+;;@ifinfo
+;;@example
+;;E. Myers and W. Miller,
+;;   "Optimal alignments in linear space",
+;;   Computer Application in the Biosciences (CABIOS), 4(1):11-17, 1988.
+;;   @url{http://www.cs.arizona.edu/people/gene/PAPERS/linear.ps}
+;;@end example
+;;@end ifinfo
+;;@ifset html
+;;<A HREF="http://www.cs.arizona.edu/people/gene/vita.html">
+;;E. Myers,</A> and W. Miller,
+;;<A HREF="http://www.cs.arizona.edu/people/gene/PAPERS/linear.ps">
+;;"Optimal alignments in linear space"</A>,
+;;Computer Application in the Biosciences (CABIOS), 4(1):11-17, 1988.
+;;@end ifset
 ;;
 ;;@noindent
 ;;If the items being sequenced are text lines, then the computed
@@ -55,24 +67,23 @@
 ;;lesser known @dfn{spiff} program.
 
 (require 'array)
-(require 'sort)
 
 ;;; p-lim is half the number of gratuitous edits for strings of given
 ;;; lengths.
 ;;; When passed #f CC, fp:compare returns edit-distance if successful;
 ;;; #f otherwise (p > p-lim).  When passed CC, fp:compare returns #f.
-(define (fp:compare fp CC A M B N =? p-lim)
+(define (fp:compare fp fpoff CC A M B N p-lim)
   (define Delta (- N M))
   ;;(if (negative? Delta) (slib:error 'fp:compare (fp:subarray A 0 M) '> (fp:subarray B 0 N)))
   ;;(set! compares (+ 1 compares))  ;(print 'fp:compare M N p-lim)
   (let loop ((p 0))
     (do ((k (- p) (+ 1 k)))
 	((>= k Delta))
-      (fp:run fp k A M B N =? CC p))
+      (fp:run fp fpoff k A M B N CC p))
     (do ((k (+ Delta p) (+ -1 k)))
 	((<= k Delta))
-      (fp:run fp k A M B N =? CC p))
-    (let ((fpval (fp:run fp Delta A M B N =? CC p)))
+      (fp:run fp fpoff k A M B N CC p))
+    (let ((fpval (fp:run fp fpoff Delta A M B N CC p)))
       ;; At this point, the cost to (fpval-Delta, fpval) is Delta + 2*p
       (cond ((and (not CC) (<= N fpval)) (+ Delta (* 2 p)))
 	    ((and (not (negative? p-lim)) (>= p p-lim)) #f)
@@ -81,11 +92,11 @@
 ;;; Traces runs of matches until they end; then set fp[k]=y.
 ;;; If CC is supplied, set each CC[y] = min(CC[y], cost) for run.
 ;;; Returns furthest y reached.
-(define (fp:run fp k A M B N =? CC p)
-  (define y (max (+ 1 (array-ref fp (+ -1 k))) (array-ref fp (+ 1 k))))
+(define (fp:run fp fpoff k A M B N CC p)
   (define cost (+ k p p))
-  (let snloop ((x (- y k))
-	       (y y))
+  (let snloop ((y (max (+ (array-ref fp (+ -1 k fpoff)) 1)
+		       (array-ref fp (+ 1 k fpoff)))))
+    (define x (- y k))
     (and CC (<= y N)
 	 (let ((xcst (- M x)))
 	   (cond ((negative? xcst))
@@ -94,9 +105,9 @@
 				   y)))))
     ;;(set! tick (+ 1 tick))
     (cond ((and (< x M) (< y N)
-		(=? (array-ref A x) (array-ref B y)))
-	   (snloop (+ 1 x) (+ 1 y)))
-	  (else (array-set! fp y k)
+		(eqv? (array-ref A x) (array-ref B y)))
+	   (snloop (+ 1 y)))
+	  (else (array-set! fp y (+ fpoff k))
 		y))))
 
 ;;; Check that only 1 and -1 steps between adjacent CC entries.
@@ -126,10 +137,7 @@
 ;;		cdx))
 ;;  CC)
 
-(define (diff:mid-split M N RR CC cost)
-  (define b-splt N)			;Default
-  (define bestrun 0)
-  (define thisrun 0)
+(define (diff:mid-split N RR CC cost)
   ;; RR is not longer than CC.  So do for each element of RR.
   (let loop ((cdx (+ 1 (quotient N 2)))
 	     (rdx (quotient N 2)))
@@ -143,18 +151,19 @@
 (define (fp:subarray RA start end)
   (define n-len (abs (- end start)))
   (if (< end start)
-      (make-shared-array RA (lambda (idx) (list (- start 1 idx))) n-len)
+      (make-shared-array RA (lambda (idx) (list (+ -1 (- start idx)))) n-len)
       (make-shared-array RA (lambda (idx) (list (+ start idx))) n-len)))
 
-(define (fp:init! fp fill mindx maxdx)
-  (do ((idx maxdx (+ -1 idx)))
-      ((< idx mindx))
+(define (fp:init! fp fpoff fill mindx maxdx)
+  (define mlim (+ fpoff mindx))
+  (do ((idx (+ fpoff maxdx) (+ -1 idx)))
+      ((< idx mlim))
     (array-set! fp fill idx)))
 
 ;;; Split A[start-a..end-a] (shorter array) into smaller and smaller chunks.
 ;;; EDX is index into EDITS.
 ;;; EPO is insert/delete polarity (+1 or -1)
-(define (diff:divide-and-conquer fp CCRR A start-a end-a B start-b end-b edits edx epo =? p-lim)
+(define (diff:divide-and-conquer fp fpoff CCRR A start-a end-a B start-b end-b edits edx epo p-lim)
   (define mid-a (quotient (+ start-a end-a) 2))
   (define len-b (- end-b start-b))
   (define len-a (- end-a start-a))
@@ -163,18 +172,20 @@
     (define RR (fp:subarray CCRR (+ len-b 1) (* 2 (+ len-b 1))))
     (define M2 (- end-a mid-a))
     (define M1 (- mid-a start-a))
-    (fp:init! CC (+ len-a len-b) 0 len-b)
-    (fp:init! fp -1 (- (+ 1 p-lim)) (+ 1 p-lim (- len-b M1)))
-    (fp:compare fp CC
+    (fp:init! CC 0 (+ len-a len-b) 0 len-b)
+    (fp:init! fp fpoff -1 (- (+ 1 p-lim)) (+ 1 p-lim (- len-b M1)))
+    (fp:compare fp fpoff CC
 		(fp:subarray A start-a mid-a) M1
-		(fp:subarray B start-b end-b) len-b =? (min p-lim len-a))
-    (fp:init! RR (+ len-a len-b) 0 len-b)
-    (fp:init! fp -1 (- (+ 1 p-lim)) (+ 1 p-lim (- len-b M2)))
-    (fp:compare fp RR
+		(fp:subarray B start-b end-b) len-b
+		(min p-lim len-a))
+    (fp:init! RR 0 (+ len-a len-b) 0 len-b)
+    (fp:init! fp fpoff -1 (- (+ 1 p-lim)) (+ 1 p-lim (- len-b M2)))
+    (fp:compare fp fpoff RR
 		(fp:subarray A end-a mid-a)   M2
-		(fp:subarray B end-b start-b) len-b =? (min p-lim len-a))
+		(fp:subarray B end-b start-b) len-b
+		(min p-lim len-a))
     ;;(smooth-costs CC len-b) (smooth-costs RR len-b)
-    (let ((b-splt (diff:mid-split len-a len-b RR CC tcst)))
+    (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))
@@ -183,49 +194,49 @@
       ;;(print 'cc cc) (print 'rr (fp:subarray RR (+ 1 len-b) 0))
       ;;(print (make-string (+ 7 (* 2 b-splt)) #\-) '^  (list b-splt))
       (check-cost! 'CC est-c
-		  (diff2et fp CCRR
+		  (diff2et fp fpoff CCRR
 			   A start-a mid-a
 			   B start-b (+ start-b b-splt)
-			   edits edx epo =?
+			   edits edx epo
 			   (quotient (- est-c (- b-splt (- mid-a start-a)))
 				     2)))
       (check-cost! 'RR est-r
-		  (diff2et fp CCRR
+		  (diff2et fp fpoff CCRR
 			   A mid-a end-a
 			   B (+ start-b b-splt) end-b
-			   edits (+ est-c edx) epo =?
+			   edits (+ est-c edx) epo
 			   (quotient (- est-r (- (- len-b b-splt)
 						 (- end-a mid-a)))
 				     2)))
       (+ est-c est-r))))
 
 ;;; Trim; then diff sub-arrays; either one longer.  Returns edit-length
-(define (diff2et fp CCRR A start-a end-a B start-b end-b edits edx epo =? p-lim)
+(define (diff2et fp fpoff CCRR A start-a end-a B start-b end-b edits edx epo p-lim)
   ;;  (if (< (- end-a start-a) p-lim) (slib:warn 'diff2et 'len-a (- end-a start-a) 'len-b (- end-b start-b) 'p-lim p-lim))
   (do ((bdx (+ -1 end-b) (+ -1 bdx))
        (adx (+ -1 end-a) (+ -1 adx)))
       ((not (and (<= start-b bdx)
 		 (<= start-a adx)
-		 (=? (array-ref A adx) (array-ref B bdx))))
+		 (eqv? (array-ref A adx) (array-ref B bdx))))
        (do ((bsx start-b (+ 1 bsx))
 	    (asx start-a (+ 1 asx)))
 	   ((not (and (< bsx bdx)
 		      (< asx adx)
-		      (=? (array-ref A asx) (array-ref B bsx))))
+		      (eqv? (array-ref A asx) (array-ref B bsx))))
 	    ;;(print 'trim-et (- asx start-a) '+ (- end-a adx))
 	    (let ((delta (- (- bdx bsx) (- adx asx))))
 	      (if (negative? delta)
-		  (diff2ez fp CCRR B bsx (+ 1 bdx) A asx (+ 1 adx)
-			   edits edx (- epo) =? (+ delta p-lim))
-		  (diff2ez fp CCRR A asx (+ 1 adx) B bsx (+ 1 bdx)
-			   edits edx epo =? p-lim))))
+		  (diff2ez fp fpoff CCRR B bsx (+ 1 bdx) A asx (+ 1 adx)
+			   edits edx (- epo) (+ delta p-lim))
+		  (diff2ez fp fpoff CCRR A asx (+ 1 adx) B bsx (+ 1 bdx)
+			   edits edx epo p-lim))))
 	 ;;(set! tick (+ 1 tick))
 	 ))
     ;;(set! tick (+ 1 tick))
     ))
 
 ;;; Diff sub-arrays, A not longer than B.  Returns edit-length
-(define (diff2ez fp CCRR A start-a end-a B start-b end-b edits edx epo =? p-lim)
+(define (diff2ez fp fpoff CCRR A start-a end-a B start-b end-b edits edx epo p-lim)
   (define len-a (- end-a start-a))
   (define len-b (- end-b start-b))
   ;;(if (> len-a len-b) (slib:error 'diff2ez len-a '> len-b))
@@ -241,7 +252,7 @@
 			   (edx edx (+ 1 edx)))
 			  ((>= idx end-b) (- len-b len-a))
 			(array-set! edits (* epo (+ 1 idx)) edx)))
-		     ((=? (array-ref A adx) (array-ref B bdx))
+		     ((eqv? (array-ref A adx) (array-ref B bdx))
 		      ;;(set! tick (+ 1 tick))
 		      (loop (+ 1 adx) (+ 1 bdx) edx))
 		     (else (array-set! edits (* epo (+ 1 bdx)) edx)
@@ -250,65 +261,39 @@
 	((<= len-a p-lim)		; delete all A; insert all B
 	 ;;(if (< len-a p-lim) (slib:error 'diff2ez len-a len-b 'p-lim p-lim))
 	 (do ((idx start-a (+ 1 idx))
-	      (edx edx (+ 1 edx)))
-	     ((>= idx end-a)
-	      (do ((jdx start-b (+ 1 jdx))
-		   (edx edx (+ 1 edx)))
-		  ((>= jdx end-b))
-		(array-set! edits (* epo (+ 1 jdx)) edx)))
-	   (array-set! edits (* epo (- -1 idx)) edx))
-	 (+ len-a len-b))
+	      (jdx start-b (+ 1 jdx)))
+	     ((and (>= idx end-a) (>= jdx end-b)) (+ len-a len-b))
+	   (cond ((< jdx end-b)
+		  (array-set! edits (* epo (+ 1 jdx)) edx)
+		  (set! edx (+ 1 edx))))
+	   (cond ((< idx end-a)
+		  (array-set! edits (* epo (- -1 idx)) edx)
+		  (set! edx (+ 1 edx))))))
 	(else (diff:divide-and-conquer
-	       fp CCRR A start-a end-a B start-b end-b
-	       edits edx epo =? p-lim))))
+	       fp fpoff CCRR A start-a end-a B start-b end-b
+	       edits edx epo p-lim))))
 
-;;;Return new vector of edits in correct sequence
-(define (diff:order-edits edits cost sign)
-  (if (negative? sign)
-      (do ((idx (+ -1 cost) (+ -1 idx)))
-	  ((negative? idx))
-	(array-set! edits (- (array-ref edits idx)) idx)))
-  (if (zero? cost)
-      edits
-      (let ((sedits (sort! edits <))
-	    (nedits (create-array (As32) cost)))
-	;; Find -/+ boundary
-	(define len-a (max 0 (- (array-ref sedits 0))))
-	(define len-b (array-ref sedits (+ -1 cost)))
-	(do ((idx 0 (+ 1 idx)))
-	    ((or (>= idx cost) (positive? (array-ref sedits idx)))
-	     (let loop ((ddx (+ -1 idx))
-			(idx idx)
-			(ndx 0)
-			(adx 0)
-			(bdx 0))
-	       (define del (if (negative? ddx) 0 (array-ref sedits ddx)))
-	       (define ins (if (>= idx cost) 0 (array-ref sedits idx)))
-	       (cond ((and (>= bdx len-b) (>= adx len-a)) nedits)
-		     ((and (negative? del) (>= adx (- -1 del))
-			   (positive? ins) (>= bdx (+ -1 ins)))
-		      (array-set! nedits del ndx)
-		      (array-set! nedits ins (+ 1 ndx))
-		      (loop (+ -1 ddx) (+ 1 idx) (+ 2 ndx)
-			    (+ 1 adx) (+ 1 bdx)))
-		     ((and (negative? del) (>= adx (- -1 del)))
-		      (array-set! nedits del ndx)
-		      (loop (+ -1 ddx) idx (+ 1 ndx) (+ 1 adx) bdx))
-		     ((and (positive? ins) (>= bdx (+ -1 ins)))
-		      (array-set! nedits ins ndx)
-		      (loop ddx (+ 1 idx)  (+ 1 ndx) adx (+ 1 bdx)))
-		     (else
-		      (loop ddx idx ndx (+ 1 adx) (+ 1 bdx))))))))))
+(define (check-cost! name est cost)
+  (if (not (eqv? est cost))
+      (slib:warn name "cost check failed" est '!= cost)))
+
+;;;; Routines interfacing API layer to algorithms.
+
+(define (diff:invert-edits! edits)
+  (define cost (car (array-dimensions edits)))
+  (do ((idx (+ -1 cost) (+ -1 idx)))
+      ((negative? idx))
+    (array-set! edits (- (array-ref edits idx)) idx)))
 
 ;;; len-a < len-b
-(define (edits2lcs lcs edits cost A len-a len-b)
+(define (edits2lcs! lcs edits A)
+  (define cost (car (array-dimensions edits)))
+  (define len-a (car (array-dimensions A)))
   (let loop ((edx 0)
 	     (sdx 0)
 	     (adx 0))
-    (let ((edit (if (< edx cost)
-		    (array-ref edits edx)
-		    0)))
-      (cond ((>= adx len-a) lcs)
+    (let ((edit (if (< edx cost) (array-ref edits edx) 0)))
+      (cond ((>= adx len-a))
 	    ((positive? edit)
 	     (loop (+ 1 edx) sdx adx))
 	    ((zero? edit)
@@ -321,67 +306,56 @@
 	     (loop edx (+ 1 sdx) (+ 1 adx)))))))
 
 ;; A not longer than B (M <= N)
-(define (diff2edits A M B N =? p-lim)
-  (define maxdx (if (negative? p-lim) (+ 2 N) (+ 1 p-lim (- N M))))
-  (define mindx (if (negative? p-lim) (- (+ 1 M)) (- (+ 1 p-lim))))
-  ;;(if (> M N) (slib:error 'diff2edits M '> N))
-  (let ((fp (create-array (As32) (list mindx maxdx)))
-	(CCRR (create-array (As32) (* 2 (+ N 1)))))
-    (fp:init! fp -1 mindx maxdx)
-    (let ((est (fp:compare fp #f A M B N =? p-lim)))
-      (and est
-	   (let ((edits (create-array (As32) est)))
-	     (check-cost! 'diff2edits
-			 est
-			 (diff2et fp CCRR A 0 M B 0 N edits 0 1 =?
-				  (quotient (- est (- N M)) 2)))
-	     edits)))))
+(define (diff2edits! edits fp CCRR A B)
+  (define N (car (array-dimensions B)))
+  (define M (car (array-dimensions A)))
+  (define est (car (array-dimensions edits)))
+  (let ((p-lim (quotient (- est (- N M)) 2)))
+    (check-cost! 'diff2edits!
+		 est
+		 (diff2et fp (+ 1 p-lim)
+			  CCRR A 0 M B 0 N edits 0 1 p-lim))))
 
 ;; A not longer than B (M <= N)
-(define (diff2editlen A M B N =? p-lim)
-  (define maxdx (if (negative? p-lim) (+ 1 N) (+ 1 p-lim (- N M))))
-  (define mindx (if (negative? p-lim) (- (+ 1 M)) (- (+ 1 p-lim))))
-  (let ((fp (create-array (As32) (list mindx maxdx))))
-    (fp:init! fp -1 mindx maxdx)
-    (fp:compare fp #f A M B N =? p-lim)))
+(define (diff2editlen fp A B p-lim)
+  (define N (car (array-dimensions B)))
+  (define M (car (array-dimensions A)))
+  (let ((maxdx (if (negative? p-lim) (+ 1 N) (+ 1 p-lim (- N M))))
+	(mindx (if (negative? p-lim) (- (+ 1 M)) (- (+ 1 p-lim)))))
+    (fp:init! fp (- mindx) -1 mindx maxdx)
+    (fp:compare fp (- mindx) #f A M B N p-lim)))
 
-(define (check-cost! name est cost)
-  (if (not (eqv? est cost))
-      (slib:warn "%s: cost check failed %d != %d\\n" name est cost)))
+;;;; API
 
-;;@args array1 array2 =? p-lim
-;;@args array1 array2 =?
-;;@1 and @2 are one-dimensional arrays.  The procedure @3 is used
-;;to compare sequence tokens for equality.
+;;@args array1 array2 p-lim
+;;@args array1 array2
+;;@1 and @2 are one-dimensional arrays.
 ;;
-;;The non-negative integer @4, if provided, is maximum number of
+;;The non-negative integer @3, if provided, is maximum number of
 ;;deletions of the shorter sequence to allow.  @0 will return @code{#f}
 ;;if more deletions would be necessary.
 ;;
 ;;@0 returns a one-dimensional array of length @code{(quotient (- (+
 ;;len1 len2) (diff:edit-length @1 @2)) 2)} holding the longest sequence
 ;;common to both @var{array}s.
-(define (diff:longest-common-subsequence A B =? . p-lim)
-  (define len-a (car (array-dimensions a)))
-  (define len-b (car (array-dimensions b)))
+(define (diff:longest-common-subsequence 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 ((edits (if (< len-b len-a)
-		   (diff2edits B len-b A len-a =? p-lim)
-		   (diff2edits A len-a B len-b =? p-lim))))
+  (let ((edits (if (< N M)
+		   (diff:edits B A p-lim)
+		   (diff:edits A B p-lim))))
     (and edits
 	 (let* ((cost (car (array-dimensions edits)))
-		(sedit (diff:order-edits edits cost (if (< len-b len-a) -1 1)))
-		(lcs (create-array A (/ (- (+ len-b len-a) cost) 2))))
-	   (if (< len-b len-a)
-	       (edits2lcs lcs sedit cost B len-b len-a)
-	       (edits2lcs lcs sedit cost A len-a len-b))))))
+		(lcs (make-array A (/ (- (+ N M) cost) 2))))
+	   (edits2lcs! lcs edits (if (< N M) B A))
+	   lcs))))
 
-;;@args array1 array2 =? p-lim
-;;@args array1 array2 =?
-;;@1 and @2 are one-dimensional arrays.  The procedure @3 is used
-;;to compare sequence tokens for equality.
+;;@args array1 array2 p-lim
+;;@args array1 array2
+;;@1 and @2 are one-dimensional arrays.
 ;;
-;;The non-negative integer @4, if provided, is maximum number of
+;;The non-negative integer @3, if provided, is maximum number of
 ;;deletions of the shorter sequence to allow.  @0 will return @code{#f}
 ;;if more deletions would be necessary.
 ;;
@@ -395,44 +369,57 @@
 ;;@item @var{k} < 0
 ;;Deletes @code{(array-ref @2 (- -1 @var{k}))} from the sequence.
 ;;@end table
-(define (diff:edits A B =? . p-lim)
-  (define len-a (car (array-dimensions a)))
-  (define len-b (car (array-dimensions b)))
+(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 ((edits (if (< len-b len-a)
-		   (diff2edits B len-b A len-a =? p-lim)
-		   (diff2edits A len-a B len-b =? p-lim))))
-    (and edits (diff:order-edits edits (car (array-dimensions edits))
-				 (if (< len-b len-a) -1 1)))))
+  (let ((fp (make-array (A:fixZ32b) (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-array (A:fixZ32b) est))
+	       (CCRR (make-array (A:fixZ32b) (* 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))))
 
-;;@args array1 array2 =? p-lim
-;;@args array1 array2 =?
-;;@1 and @2 are one-dimensional arrays.  The procedure @3 is used
-;;to compare sequence tokens for equality.
+;;@args array1 array2 p-lim
+;;@args array1 array2
+;;@1 and @2 are one-dimensional arrays.
 ;;
-;;The non-negative integer @4, if provided, is maximum number of
+;;The non-negative integer @3, if provided, is maximum number of
 ;;deletions of the shorter sequence to allow.  @0 will return @code{#f}
 ;;if more deletions would be necessary.
 ;;
 ;;@0 returns the length of the shortest sequence of edits transformaing
 ;;@1 to @2.
-(define (diff:edit-length A B =? . p-lim)
-  (define M (car (array-dimensions a)))
-  (define N (car (array-dimensions b)))
+(define (diff:edit-length 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)))
-  (if (< N M)
-      (diff2editlen B N A M =? p-lim)
-      (diff2editlen A M B N =? p-lim)))
+  (let ((fp (make-array (A:fixZ32b) (if (negative? p-lim)
+					(+ 3 M N)
+					(+ 3 (abs (- N M)) p-lim p-lim)))))
+    (if (< N M)
+	(diff2editlen fp B A p-lim)
+	(diff2editlen fp A B p-lim))))
 
 ;;@example
-;;(diff:longest-common-subsequence "fghiejcklm" "fgehijkpqrlm" eqv?)
+;;(diff:longest-common-subsequence "fghiejcklm" "fgehijkpqrlm")
 ;;@result{} "fghijklm"
 ;;
-;;(diff:edit-length "fghiejcklm" "fgehijkpqrlm" eqv?)
+;;(diff:edit-length "fghiejcklm" "fgehijkpqrlm")
 ;;@result{} 6
 ;;
-;;(diff:edits "fghiejcklm" "fgehijkpqrlm" eqv?)
-;;@result{} #As32(3 -5 -7 8 9 10)
+;;(diff:edits "fghiejcklm" "fgehijkpqrlm")
+;;@result{} #A:fixZ32b(3 -5 -7 8 9 10)
 ;;       ; e  c  h p q  r
 ;;@end example