diff options
author | Ludovic Court`es | 2007-04-10 07:48:46 +0000 |
---|---|---|
committer | Ludovic Court`es | 2007-04-10 07:48:46 +0000 |
commit | a6782866e36cd1b7c8458e4efdec53d7c405a245 (patch) | |
tree | bc38d0ac1d6fd7f7d5b8732a804e9f0ed74d97b1 /src/guile/diff.scm | |
parent | 722c149e96b680f3ee16925c24c0fb197adbab40 (diff) | |
parent | 45afa1a5ddc609d9cbfaeba8fc8fd353a9191e43 (diff) | |
download | skribilo-a6782866e36cd1b7c8458e4efdec53d7c405a245.tar.gz skribilo-a6782866e36cd1b7c8458e4efdec53d7c405a245.tar.lz skribilo-a6782866e36cd1b7c8458e4efdec53d7c405a245.zip |
`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: skribilo@sv.gnu.org--2006/skribilo--devo--1.2--patch-90
Diffstat (limited to 'src/guile/diff.scm')
-rw-r--r-- | src/guile/diff.scm | 46 |
1 files changed, 22 insertions, 24 deletions
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 |