Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

adding levenshtein distance

Browse source
This commit is contained in:
Alex Shinn 2019-11-04 20:15:32 +08:00
parent 6f57d6ac71
commit 7b6a928974
2 changed files with 46 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
lib/chibi/edit-distance-test.sld Normal file
View file

@ -0,0 +1,14 @@
(define-library (chibi edit-distance-test)
(export run-tests)
(import (scheme base) (chibi edit-distance) (chibi test))
(begin
(define (run-tests)
(test-begin "(chibi edit-distance)")
(test 0 (edit-distance "" ""))
(test 0 (edit-distance "same" "same"))
(test 1 (edit-distance "same" "game"))
(test 2 (edit-distance "same" "sand"))
(test 3 (edit-distance "kitten" "sitting"))
(test 3 (edit-distance "Saturday" "Sunday"))
(test-end))))

32
lib/chibi/edit-distance.sld Normal file
View file

@ -0,0 +1,32 @@
(define-library (chibi edit-distance)
(export edit-distance)
(import (scheme base) (srfi 130))
(begin
;; levenshtein (quadratic time, linear memory)
(define (edit-distance s1 s2)
(let* ((len1 (string-length s1))
(len2 (string-length s2))
(vec (make-vector (+ len1 1) 0)))
(do ((i 0 (+ i 1)))
((> i len1))
(vector-set! vec i i))
(do ((i 1 (+ i 1))
(sc2 (string-cursor-start s2) (string-cursor-next s2 sc2)))
((> i len2)
(vector-ref vec len1))
(vector-set! vec 0 i)
(let ((ch2 (string-ref/cursor s2 sc2)))
(let lp ((j 1)
(sc1 (string-cursor-start s1))
(last-diag (- i 1)))
(when (<= j len1)
(let ((old-diag (vector-ref vec j))
(ch1 (string-ref/cursor s1 sc1)))
(vector-set! vec j (min (+ (vector-ref vec j) 1)
(+ (vector-ref vec (- j 1)) 1)
(+ last-diag
(if (eqv? ch1 ch2) 0 1))))
(lp (+ j 1)
(string-cursor-next s1 sc1)
old-diag))))))))))