; levenshtein distance

(define (make-matrix rows columns . value)
  (do ((m (make-vector rows)) (i 0 (+ i 1)))
      ((= i rows) m)
    (if (null? value)
        (vector-set! m i (make-vector columns))
        (vector-set! m i (make-vector columns (car value))))))

(define (matrix-ref m i j) (vector-ref (vector-ref m i) j))

(define (matrix-set! m i j x) (vector-set! (vector-ref m i) j x))

(define (exponential-levenshtein x y)
  (let loop ((xs (string->list x)) (ys (string->list y)))
    (cond ((null? xs) (length ys))
          ((null? ys) (length xs))
          ((char=? (car xs) (car ys))
            (loop (cdr xs) (cdr ys)))
          (else (+ 1 (min (loop (cdr xs) ys)
                          (loop xs (cdr ys))
                          (loop (cdr xs) (cdr ys))))))))

(display (time (exponential-levenshtein "persimmon" "cantaloupe"))) (newline)
(display (time (exponential-levenshtein "persimmons" "cantaloupes"))) (newline)

(define (dynamic-programming-levenshtein x y)
  (let* ((x-len (string-length x))
         (y-len (string-length y))
         (costs (make-matrix (+ x-len 1) (+ y-len 1) 0)))
    (do ((i 0 (+ i 1))) ((< x-len i))
      (do ((j 0 (+ j 1))) ((< y-len j))
        (matrix-set! costs i j (+ i j))))
    (do ((i 1 (+ i 1))) ((< x-len i))
      (do ((j 1 (+ j 1))) ((< y-len j))
        (let ((add-cost (+ (matrix-ref costs (- i 1) j) 1))
              (del-cost (+ (matrix-ref costs i (- j 1)) 1))
              (sub-cost (+ (matrix-ref costs (- i 1) (- j 1))
                           (if (char=? (string-ref x (- i 1))
                                       (string-ref y (- j 1)))
                               0 1))))
          (matrix-set! costs i j
            (min add-cost del-cost sub-cost)))))
    (matrix-ref costs x-len y-len)))

(display (time (dynamic-programming-levenshtein "persimmon" "cantaloupe"))) (newline)
(display (time (dynamic-programming-levenshtein "persimmons" "cantaloupes"))) (newline)

cpu time: 490 real time: 490 gc time: 0
10
cpu time: 2119 real time: 2119 gc time: 0
10
cpu time: 0 real time: 1 gc time: 0
10
cpu time: 0 real time: 1 gc time: 0
10