Function: LEVENSHTEIN-DISTANCE

Source

(defun levenshtein-distance (source target &key (test #'eql))
  (block nil
    (let ((source-length (length source))
	  (target-length (length target)))
      (when (zerop source-length)
	(return target-length))
      (when (zerop target-length)
	(return source-length))
      (let ((buffer (make-array (1+ target-length))))
	(dotimes (i (1+ target-length))
	  (setf (aref buffer i) i))
	;; we make a slight modification to the alogrithm described
	;; above. we don't create the entire array, just enough to
	;; keep the info we need, which is an array of size
	;; target-length + the "above" value and the "over". (this is
	;; similar to the optimizaiont for determining lcs).
	(loop
	   for i from 1 upto source-length
	   do (setf (aref buffer 0) i)
	   do (loop
		 with above-value = i
		 with over-value = (1- i)
		 for j from 1 upto target-length
		 for cost = (if (funcall test (elt source (1- i))
					      (elt target (1- j)))
				0 1)
		 do (let ((over-value* (aref buffer j)))
		      (setf (aref buffer j) (min (1+ above-value)
						 (1+ (aref buffer j))
						 (+ cost over-value))
			    above-value (aref buffer j)
			    over-value over-value*))))
	(return (aref buffer target-length))))))