diff options
author | Thomas Bushnell, BSG <tb@debian.org> | 2005-11-02 14:55:21 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:32 -0800 |
commit | 34c54a22ff7818bb8b38ef4d9c87dbbcb221ba73 (patch) | |
tree | 1189d06a81277bcf8539b0260a69a19f6038effb /differ.scm | |
parent | 611b3db17894e5fdc0db3d49eaf6743d27b44233 (diff) | |
parent | 5145dd3aa0c02c9fc496d1432fc4410674206e1d (diff) | |
download | slib-34c54a22ff7818bb8b38ef4d9c87dbbcb221ba73.tar.gz slib-34c54a22ff7818bb8b38ef4d9c87dbbcb221ba73.zip |
Import Debian changes 3a2-1debian/3a2-1
slib (3a2-1) unstable; urgency=low
* New upstream release.
* Acknowledge NMU. (Closes: #281809)
* Makefile: Don't hack Makefile; use rules instead.
* debian/rules: Set on make invocations: prefix, htmldir, TEXI2HTML.
* debian/rules (clean): Clean more stuff here.
* Makefile: Comment out old rule for $(htmldir)slib_toc.html. Instead,
specify directly that the texi2html invocation produces that file.
* debian/rules (binary-indep): Find web files in slib subdir.
* debian/control (Build-Depends-Indep): Go back to using scm.
Diffstat (limited to 'differ.scm')
-rw-r--r-- | differ.scm | 331 |
1 files changed, 159 insertions, 172 deletions
@@ -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 |