summaryrefslogtreecommitdiffstats
path: root/differ.scm
diff options
context:
space:
mode:
authorBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:38 -0800
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:38 -0800
commit64f037d91e0c9296dcaef9a0ff3eb33b19a2ed34 (patch)
tree1b23b8e8005328194e2fb4bf653806c85050933f /differ.scm
parent5bea21e81ed516440e34e480f2c33ca41aa8c597 (diff)
downloadslib-64f037d91e0c9296dcaef9a0ff3eb33b19a2ed34.tar.gz
slib-64f037d91e0c9296dcaef9a0ff3eb33b19a2ed34.zip
Import Upstream version 3a5upstream/3a5
Diffstat (limited to 'differ.scm')
-rw-r--r--differ.scm44
1 files changed, 21 insertions, 23 deletions
diff --git a/differ.scm b/differ.scm
index 6acc253..bd363d4 100644
--- a/differ.scm
+++ b/differ.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
;
;Permission to copy this software, to modify it, to redistribute it,
;to distribute modified versions, and to use it for any purpose is
@@ -188,11 +188,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
@@ -372,23 +371,22 @@
(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-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))))
+ (define est (diff:edit-length A B (if (null? p-lim) -1 (car p-lim))))
+ (and est
+ (let ((CCRR (make-array (A:fixZ32b) (* 2 (+ (max M N) 1))))
+ (edits (make-array (A:fixZ32b) est)))
+ (define fp (make-array (A:fixZ32b)
+ (+ (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
@@ -423,4 +421,4 @@
;; ; 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