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

Last change on this file since 38874 was 38874, checked in by Kon Lovett, 2 months ago

add functor types include, note path-iterator bug

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