计算两个字符串之间的编辑距离，并以文字形式进行转换过程的报告。

editance.lisp

(defpackage :com.liutos.editance
  (:use :cl))

(in-package :com.liutos.editance)

(defmacro for ((var start end) &body body)
  `(do ((,var ,start (1+ ,var)))
       ((> ,var ,end))
     ,@body))

(defun editance (str1 str2)
  (let* ((row (1+ (length str1)))
	 (col (1+ (length str2)))
	 (aux (make-array (list row col))))
    (for (i 0 (1- row))
      (setf (aref aux i 0) i))
    (for (j 1 (1- col))
      (setf (aref aux 0 j) j))
    (for (i 1 (1- row))
      (for (j 1 (1- col))
	(setf (aref aux i j)
	      (min (1+ (aref aux (1- i) j))
		   (1+ (aref aux i (1- j)))
		   (+ (aref aux (1- i) (1- j))
		      (if (char= (char str1 (1- i))
				 (char str2 (1- j)))
			  0 1))))))
    aux))

(defun next-ij (str1 str2 aux i j)
  (let ((lt (aref aux (1- i) (1- j)))
	(tp (aref aux (1- i) j))
	(lf (aref aux i (1- j)))
	(diff (if (char= (char str1 (1- i))
			 (char str2 (1- j))) 0 1)))
    (cond ((<= (1+ lf) (min (1+ tp) (+ diff lt)))
	   (values i (1- j)))
	  ((<= (1+ tp) (min (1+ lf) (+ diff lt)))
	   (values (1- i) j))
	  (t (values (1- i) (1- j))))))

(defun find-change (str1 str2 aux)
  (labels ((rec (acc i j)
	     (cond ((and (zerop i) (zerop j)) acc)
		   ((zerop i)
		    (rec (cons (cons #\- (char str2 (- j 1))) acc)
			 0 (1- j)))
		   ((zerop j)
		    (rec (cons (cons (char str1 (- i 1)) #\-) acc)
			 (1- i) 0))
		   (t
		    (multiple-value-bind (ni nj)
			(next-ij str1 str2 aux i j)
		      (cond ((= ni i)
			     (rec (cons (cons #\- (char str2 (1- j))) acc)
				  ni nj))
			    ((= nj j)
			     (rec (cons (cons (char str1 (1- i)) #\-) acc)
				  ni nj))
			    (t (rec (cons (cons (char str1 (1- i))
						(char str2 (1- j))) acc)
				    ni nj))))))))
    (let ((row (array-dimension aux 0))
	  (col (array-dimension aux 1)))
      (rec '() (1- row) (1- col)))))

(defun report-ex (c1s c2s)
  (dotimes (i (length c1s))
    (let ((c1 (char c1s i))
	  (c2 (char c2s i)))
      (cond ((char= #\- c1)
	     (format t "~&Insert character ~A.~%" c2))
	    ((char= #\- c2)
	     (format t "Delete character ~A.~%" c1))
	    ((char/= c1 c2)
	     (format t "Change character ~A to ~A.~%" c1 c2))
	    (t (format t "Keep character ~A unchanged.~%" c1))))))

(defun report-editance (str1 str2)
  (let ((change (find-change str1 str2 (editance str1 str2))))
    (loop :for (c1 . c2) :in change
       :collect c1 :into c1s
       :collect c2 :into c2s
       :finally (report-ex (coerce c1s 'string)
			   (coerce c2s 'string)))))