source: project/release/5/levenshtein/trunk/tests/levenshtein-test.scm @ 38890

Last change on this file since 38890 was 38890, checked in by Kon Lovett, 8 weeks ago

rm dep

File size: 9.3 KB
Line 
1;;;; levenshtein-test.scm -*- Scheme -*-
2
3(import test)
4
5(include "test-gloss.incl")
6
7(test-begin "Levenshtein")
8
9;;;
10
11;until R⁷RS
12(define (string->vector s) (list->vector (string->list s)))
13
14;;;
15
16;;;
17
18(import levenshtein-operators)
19
20(test-begin "Levenshtein Operators")
21
22#| ;#, compiled must be from -extend
23(test-group "Operations"
24
25  (test "Insert ref" '#,(levenshtein-operator Insert "Insert" 1 0 1)
26    (levenshtein-operator-ref 'Insert))
27
28  (test "Transpose ref" '#,(levenshtein-operator Transpose "Transpose" 1 2 2)
29    (levenshtein-operator-ref 'Transpose))
30
31  (test-assert "Make foo"
32    (levenshtein-operator=?
33      '#,(levenshtein-operator foo "foo" 0.5 12 1)
34      (make-levenshtein-operator 'foo "foo" 0.5 12 1)))
35
36  ;-- Do not re-order these
37  (test-assert "Set! foo"
38    (levenshtein-operator-set! (make-levenshtein-operator 'foo "foo" 0.5 12 1)))
39
40  (test-assert "Ref foo"
41    (levenshtein-operator=?
42      '#,(levenshtein-operator foo "foo" 0.5 12 1)
43      (levenshtein-operator-ref 'foo)))
44
45  (test-assert "Delete! foo" (levenshtein-operator-delete! 'foo))
46  ;--
47
48  (test-assert "Delete clone ="
49    (levenshtein-operator=?
50      '#,(levenshtein-operator Delete "Delete" 0.5 1 0)
51      (clone-levenshtein-operator 'Delete cost: 0.5)))
52)
53|#
54(test-group "Operations"
55
56  (test "Insert ref" (make-levenshtein-operator 'Insert "Insert" 1 0 1)
57    (levenshtein-operator-ref 'Insert))
58
59  (test "Transpose ref" (make-levenshtein-operator 'Transpose "Transpose" 1 2 2)
60    (levenshtein-operator-ref 'Transpose))
61
62  #; ;why bother
63  (test-assert "Make foo"
64    (levenshtein-operator=?
65      (make-levenshtein-operator 'foo "foo" 0.5 12 1)
66      (make-levenshtein-operator 'foo "foo" 0.5 12 1)))
67
68  ;-- Do not re-order these
69  (test-assert "Set! foo"
70    (levenshtein-operator-set! (make-levenshtein-operator 'foo "foo" 0.5 12 1)))
71
72  (test-assert "Ref foo"
73    (levenshtein-operator=?
74      (make-levenshtein-operator 'foo "foo" 0.5 12 1)
75      (levenshtein-operator-ref 'foo)))
76
77  (test-assert "Delete! foo" (levenshtein-operator-delete! 'foo))
78  ;--
79
80  (test-assert "Delete clone ="
81    (levenshtein-operator=?
82      (make-levenshtein-operator 'Delete "Delete" 0.5 1 0)
83      (clone-levenshtein-operator 'Delete cost: 0.5)))
84)
85
86(test-end "Levenshtein Operators")
87
88;;;
89
90(import (srfi 63))
91(import levenshtein-vector)
92
93(test-begin "Levenshtein Vector")
94
95(let ()
96
97    (define (cost-and-oper-matrix-match? l)
98      (and (= 2 (length l))
99           (= 6 (car l))
100           (array? (cadr l))))
101
102  (test-group "levenshtein"
103    (let ((YWCQPGK (string->vector "YWCQPGK"))
104          (LAWYQQKPGKA (string->vector "LAWYQQKPGKA")) )
105
106      (test "distance" 6
107        (let-values (((cost _) (levenshtein-distance/vector* YWCQPGK LAWYQQKPGKA))) cost))
108
109      (test-assert "cost-and-oper-matrix-match"
110        (cost-and-oper-matrix-match?
111          (receive
112            (levenshtein-distance/vector* YWCQPGK LAWYQQKPGKA operations: #t))))
113
114      (test-assert "cost-and-oper-matrix-match: explicit opers"
115        (cost-and-oper-matrix-match?
116          (receive
117            (levenshtein-distance/vector* YWCQPGK LAWYQQKPGKA operations: #t
118              (levenshtein-operator-ref 'Insert)
119              (levenshtein-operator-ref 'Delete)
120              (levenshtein-operator-ref 'Substitute)
121              (levenshtein-operator-ref 'Transpose)))))
122    )
123  )
124)
125
126(test-end "Levenshtein Vector")
127
128(include "levenshtein-cost-fixnum")
129(import levenshtein-vector-functor)
130(module levenshtein-vector-fixnum = (levenshtein-vector-functor levenshtein-cost-fixnum))
131(import (prefix levenshtein-vector-fixnum fx:))
132
133;;
134
135(test-begin "Levenshtein Vector Functor")
136
137(let ()
138
139    (define (cost-and-oper-matrix-match? l)
140      (and (= 2 (length l))
141           (= 6 (car l))
142           (array? (cadr l))))
143
144  (test-group "fixnum cost"
145    (let ((YWCQPGK (string->vector "YWCQPGK"))
146          (LAWYQQKPGKA (string->vector "LAWYQQKPGKA")) )
147
148      (test "distance" 6
149        (let-values (((cost _) (fx:levenshtein-distance/vector* YWCQPGK LAWYQQKPGKA))) cost))
150
151      (test-assert "cost-and-oper-matrix-match"
152        (cost-and-oper-matrix-match?
153          (receive
154            (fx:levenshtein-distance/vector* YWCQPGK LAWYQQKPGKA operations: #t))))
155
156      (test-assert "cost-and-oper-matrix-match: explicit opers"
157        (cost-and-oper-matrix-match?
158          (receive
159            (fx:levenshtein-distance/vector* YWCQPGK LAWYQQKPGKA operations: #t
160              (levenshtein-operator-ref 'Insert)
161              (levenshtein-operator-ref 'Delete)
162              (levenshtein-operator-ref 'Substitute)
163              (levenshtein-operator-ref 'Transpose)))))
164    )
165  )
166)
167
168(test-end "Levenshtein Vector Functor")
169
170;;;
171
172(import levenshtein-path-iterator)
173(import levenshtein-print)
174
175(test-begin "Levenshtein Path Iterator")
176
177(let ()
178
179    ;FIXME these are a transpose of the actual PM since source length < target length
180    ; see YWCQPGK & LAWYQQKPGKA above, shortest used for target
181    ; not a problem in practice since path is the same
182
183    (define (costs-list)
184      (list
185        1 2 3 3 4 5 6 7 8 9 10
186        2 2 2 3 4 5 6 7 8 9 10
187        3 3 3 3 4 5 6 7 8 9 10
188        4 4 4 4 3 4 5 6 7 8 9
189        5 5 5 5 4 4 5 5 6 7 8
190        6 6 6 6 5 5 5 6 5 6 7
191        7 7 7 7 6 6 5 6 6 5 6))
192
193    (define (opers-list)
194      (let ((io (levenshtein-operator-ref 'Insert))
195            (so (levenshtein-operator-ref 'Substitute))
196            (do (levenshtein-operator-ref 'Delete)))
197        (list
198          so do do so do do do do do do do
199          io so so do do do do do do do do
200          io io io so do do do do do do do
201          io io io io so do do do do do do
202          io io io io io so do so do do do
203          io io io io io io so io so do do
204          io io io io io io so do io so do)))
205
206    (define (gen-test-pm)
207      (let ((rs 7) (cs 11))
208        (let ((pm (make-array '#() rs cs))
209              (costs (costs-list))
210              (opers (opers-list)))
211          (do ((r 0 (add1 r)))
212              ((= r rs) pm)
213            (do ((c 0 (add1 c)))
214                ((= c cs))
215              (let ((cost (car costs)) (oper (car opers)))
216                (set! costs (cdr costs))
217                (set! opers (cdr opers))
218                (array-set! pm (cons cost oper) r c) ) ) ) ) ) )
219
220    (define *test-pm* (gen-test-pm))
221
222    (define (gen-real-iter-vec)
223      (let ((iter (levenshtein-path-iterator *test-pm*)) (vec (make-vector 6)))
224        (do ((r (iter) (iter))
225             (i 0 (add1 i)))
226            ;FIXME path-iterator goes +1 too far
227            ((or (not r) (= (vector-length vec) i)) vec)
228          (vector-set! vec i r))))
229
230    (define (gen-test-iter-vec)
231      (let ((vec (make-vector 6))
232            (io (levenshtein-operator-ref 'Insert))
233            (so (levenshtein-operator-ref 'Substitute))
234            (do (levenshtein-operator-ref 'Delete)))
235        (vector-set! vec 0
236          `((1 0 0 ,so) (2 1 1 ,so) (3 2 3 ,so) (4 4 5 ,so) (5 4 6 ,do) (6 6 10 ,do)))
237        (vector-set! vec 1
238          `((1 0 0 ,so) (2 0 1 ,do) (3 2 3 ,so) (4 4 5 ,so) (5 4 6 ,do) (6 6 10 ,do)))
239        (vector-set! vec 2
240          `((1 0 0 ,so) (2 1 1 ,so) (3 2 3 ,so) (4 3 5 ,do) (5 4 6 ,do) (6 6 10 ,do)))
241        (vector-set! vec 3
242          `((1 0 0 ,so) (2 0 1 ,do) (3 2 3 ,so) (4 3 5 ,do) (5 4 6 ,do) (6 6 10 ,do)))
243        (vector-set! vec 4
244          `((1 0 0 ,so) (2 1 1 ,so) (3 2 3 ,so) (4 3 5 ,do) (5 3 6 ,do) (6 6 10 ,do)))
245        (vector-set! vec 5
246          `((1 0 0 ,so) (2 0 1 ,do) (3 2 3 ,so) (4 3 5 ,do) (5 3 6 ,do) (6 6 10 ,do)))
247        vec))
248
249  (gloss "A Path Matrix:")
250  (print-levenshtein-matrix *test-pm*)
251
252  (test-assert "iterator proc" (procedure? (levenshtein-path-iterator *test-pm*)))
253
254  (test-group "iterator path"
255     (let ((vec (gen-test-iter-vec))
256           (rvec (gen-real-iter-vec)) )
257        (test "gen 0" (vector-ref vec 0) (vector-ref rvec 0))
258        (test "gen 1" (vector-ref vec 1) (vector-ref rvec 1))
259        (test "gen 2" (vector-ref vec 2) (vector-ref rvec 2))
260        (test "gen 3" (vector-ref vec 3) (vector-ref rvec 3))
261        (test "gen 4" (vector-ref vec 4) (vector-ref rvec 4))
262        (test "gen 5" (vector-ref vec 5) (vector-ref rvec 5))
263    )
264  )
265)
266
267(test-end "Levenshtein Path Iterator")
268
269;;;
270
271;FIXME UTF-8 Chars!
272
273(test-begin "Levenshtein Sequence Functor")
274
275(include "levenshtein-cost-number")
276(include "levenshtein-sequence-utf8")
277(import levenshtein-sequence-functor)
278(module levenshtein-sequence-number-utf8 = (levenshtein-sequence-functor levenshtein-cost-number levenshtein-sequence-utf8))
279(import (prefix levenshtein-sequence-number-utf8 fnu8:))
280
281(test-group "number cost & utf8 string"
282  (test 6
283    (fnu8:levenshtein-distance/sequence "YWCQPGK" "LAWYQQKPGKA"
284      #:elm-eql char=?))
285  (test 5
286    (fnu8:levenshtein-distance/sequence "YWCQPGK" "LAWYQQKPGKA"
287      #:elm-eql char=? #:limit-cost 5))
288  (test 2.75
289    (fnu8:levenshtein-distance/sequence "YWCQPGK" "LAWYQQKPGKA"
290      #:insert-cost 0.5 #:delete-cost 0.25 #:substitute-cost 0.75
291      #:elm-eql char=?))
292
293  (test 9
294    (fnu8:levenshtein-distance/sequence "匷食" "匱肉匷食秋冬あいうえお"
295      #:elm-eql char=?))
296  (test 5
297    (fnu8:levenshtein-distance/sequence "匷食" "匱肉匷食秋冬あいうえお"
298      #:elm-eql char=? #:limit-cost 5))
299  (test 2.75
300    (fnu8:levenshtein-distance/sequence "匷食" "匱肉匷食秋冬あいうえお"
301      #:insert-cost 0.5 #:delete-cost 0.25 #:substitute-cost 0.75
302      #:elm-eql char=?))
303)
304
305(test-end "Levenshtein Sequence Functor")
306
307;;;
308
309(test-end "Levenshtein")
310
311(test-exit)
Note: See TracBrowser for help on using the repository browser.