blob: 5fd79c8d5beef0376a8e4581d14699e95fcc9b42 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
;;;; Linear-space O(PN) sequence comparison.
;;; "Idiffer.scm" Top-level sequence-comparison functions.
;; Copyright (C) 2003, 2004 Free Software Foundation, Inc.
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Lesser General Public License as
;; published by the Free Software Foundation, either version 3 of the
;; License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Lesser General Public License for more details.
;;
;; You should have received a copy of the GNU Lesser General Public
;; License along with this program. If not, see
;; <http://www.gnu.org/licenses/>.
;;; Author: Aubrey Jaffer
(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)))
(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))
((positive? edit)
(loop (+ 1 edx) sdx adx))
((zero? edit)
(array-set! lcs (array-ref A adx) sdx)
(loop edx (+ 1 sdx) (+ 1 adx)))
((>= adx (- -1 edit))
(loop (+ 1 edx) sdx (+ 1 adx)))
(else
(array-set! lcs (array-ref A adx) sdx)
(loop edx (+ 1 sdx) (+ 1 adx)))))))
(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 (< N M)
(diff:edits B A p-lim)
(diff:edits A B p-lim))))
(and edits
(let* ((cost (car (array-dimensions edits)))
(lcs (make-array A (/ (- (+ N M) cost) 2))))
(edits2lcs! lcs edits (if (< N M) B A))
lcs))))
(define (diff:edits A B . p-lim)
(define M (car (array-dimensions A)))
(define N (car (array-dimensions B)))
(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)))
edits)))
(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)))
(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))))
|
