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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
;; 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 General Public License as published by
;; the Free Software Foundation; either version 2, 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 General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this software; see the file COPYING. If not, write to
;; the Free Software Foundation, 59 Temple Place, Suite 330, Boston, MA 02111, USA.
;;
;; As a special exception, the Free Software Foundation gives permission
;; for additional uses of the text contained in its release of SCM.
;;
;; The exception is that, if you link the SCM library with other files
;; to produce an executable, this does not by itself cause the
;; resulting executable to be covered by the GNU General Public License.
;; Your use of that executable is in no way restricted on account of
;; linking the SCM library code into it.
;;
;; This exception does not however invalidate any other reasons why
;; the executable file might be covered by the GNU General Public License.
;;
;; This exception applies only to the code released by the
;; Free Software Foundation under the name SCM. If you copy
;; code from other Free Software Foundation releases into a copy of
;; SCM, as the General Public License permits, the exception does
;; not apply to the code that you add in this way. To avoid misleading
;; anyone as to the status of such modified files, you must delete
;; this exception notice from them.
;;
;; If you write modifications of your own for SCM, it is your choice
;; whether to permit this exception to apply to your modifications.
;; If you do not wish that, delete this exception notice.
;;;; Linear-space O(PN) sequence comparison.
;;; "Idiffer.scm" Top-level sequence-comparison functions.
;;; 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)))
(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)))
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))))
|
