|
to the weblog
back to the front page
editierabstand.lisp
an implementation of the edit distance This is an implementation of the edit distance as it is defined in the lecture Informatik IV, SS 2004 at the University of Karlsruhe (TH). And yes, it is not optimized at all.. :o) A link to the plain Lisp file is available at the end of this page. Yes, you have to scroll manually. Example sessionCL-USER> (abstand-pretty "Bananen" "Ananas") ;; Informatik IV-Klausur Juli 2003, Aufgabe 4 B a n a n e n 0 1 2 3 4 5 6 7 A 1 2 1 2 3 4 5 6 n 2 3 2 1 2 3 4 5 a 3 4 3 2 1 2 3 4 n 4 5 4 3 2 1 2 3 a 5 6 5 4 3 2 3 4 s 6 7 6 5 4 3 4 5 NIL CL-USER> (abstand-bouncing-delete "Ornament" "Deodorant") ;; Informatik IV-Klausur Oktober 2003, Aufgabe 4 O r n a m e n t 0 1 2 3 4 5 6 7 8 D 1 2 3 4 5 6 7 8 9 e 1 2 3 4 5 6 6 7 8 o 2 1 2 3 4 5 6 7 8 d 2 3 4 5 6 7 7 8 9 o 3 2 3 4 5 6 7 8 9 r 3 4 2 3 4 5 6 7 8 a 4 3 4 5 3 4 5 6 7 n 4 5 3 4 5 6 7 5 6 t 5 4 5 6 4 5 6 7 5 NIL ImplementierungsideeIch finde die Implementierung recht elegant, da auch nullte Zeile und Spalte durch das Editierschema bestimmt werden, so daß man leicht Schemata ausprobieren kann, die mehr als ein Zeichen löschen oder Einfügen. (Lediglich das Element (0,0) muß selbstverständlich definiert sein.) Trotzdem ist die Implementierung des Schemas einfach. Bei Common Lisp wird ein SIMPLE-ERROR ausgelöst, wenn man versucht, auf nicht vorhandene Array-Elemente zuzugreifen, dieser Fehler wird einer eigenen kleinen Array-Zugriffsfunktion AREF-OR-INFINITY abgefangen, die in diesem Fall das Symbol +INFINITY zurückliefert. Desweiteren gibt es zwei einfache Varianten der Funktionen min und +, die mit +INFINITY umgehen können (jedenfalls soweit das benötigt wird). Mit Hilfe dieser Funktionen kann man das Editierschema einfach schreiben, ohne zusätliche Test für erste Zeile und Spalte einzufügen; wird dort nämlich versucht, auf ein Element der nicht-vorhandenen, vorhergehenden Zeile (resp. Spalte) zuzugreifen, ergibt dies +INFINITY, was dann natürlich selten das Minimum sein wird. (Es wäre sogar ein Fehler, da ein Editierabstand zwischen zwei Zeichenfolgen nie unendlich groß sein kann, deswegen (und um die Funktion möglichst kurz zu halten) wird der Fall von min* auch nicht bedacht.) Htmlized version of editierabstand.lisp;; some helper functions (defun aref-or-infinity (matrix i j) "like aref but returns '+INFINITY if the indices are out bounds for the array" (handler-case (aref matrix i j) (simple-error () '+INFINITY))) (defun min* (&rest args) (apply #'min (delete '+INFINITY args))) (defun add* (&rest args) (or (find '+INFINITY args) (apply #'+ args))) ;; print nothing, return the matrix (defun abstand (v w) "Ermittelt den Editierabstand zw. v und w, unter den Operationen Löschen, Einfügen und Übernehmen" (let ((matrix (make-array (list (1+ (length w)) (1+ (length v)) ) :element-type 'fixnum))) (dotimes (i (1+ (length w))) ;; rows (dotimes (j (1+ (length v))) ;; columns (setf (aref matrix i j) (if (and (= i 0) (= j 0)) ;; (setf (aref matrix 0 0) 0) 0 (min* (add* (aref-or-infinity matrix (1- i) j ) 1) ;; remove (add* (aref-or-infinity matrix i (1- j)) 1) ;; insert (add* (aref-or-infinity matrix (1- i) (1- j)) ;; take over (if (and (>= i 1) (>= j 1) ;; exclude zero cols/rows (char-equal (elt v (1- j)) (elt w (1- i)))) 0 '+INFINITY))))))) matrix)) ;; replace by (aref matrix (length w) (length v)))) for value only ;; a variation that prints the matrix and the strings v and w prettily (defun abstand-pretty (v w) "Ermittelt den Editierabstand zw. v und w, unter den Operationen Löschen, Einfügen und Übernehmen" (let ((matrix (make-array (list (1+ (length w)) (1+ (length v)) ) :element-type 'fixnum))) (format t " ~{ ~c~}~%" (coerce v 'list)) ;; print v (dotimes (i (1+ (length w))) ;; rows (format t "~c" (if (zerop i) " " (elt w (1- i)))) ;; print w (dotimes (j (1+ (length v))) ;; columns (format t "~3d" (setf (aref matrix i j) (if (and (zerop i) (zerop j)) ;; (setf (aref matrix 0 0) 0) 0 (min* (add* (aref-or-infinity matrix (1- i) j ) 1) ;; remove (add* (aref-or-infinity matrix i (1- j)) 1) ;; insert (add* (aref-or-infinity matrix (1- i) (1- j)) ;; take over (if (and (>= i 1) (>= j 1) ;; exclude zero cols/rows (char-equal (elt v (1- j)) (elt w (1- i)))) 0 '+INFINITY))))))) (format t "~%")) matrix nil)) ;; remove nil if you want this to return the matrix ;; same with 2x-delete ("bouncing delete key") ;; (cf. Nachklausur Informatik IV 18.10.2003, Aufgabe 4) (defun abstand-bouncing-delete (v w) "Ermittelt den Editierabstand zw. v und w, unter den Operationen 2x-Löschen, Einfügen und Übernehmen" (let ((matrix (make-array (list (1+ (length w)) (1+ (length v)) ) :element-type 'fixnum))) (format t " ~{ ~c~}~%" (coerce v 'list)) ;; print v (dotimes (i (1+ (length w))) ;; rows (format t "~c" (if (zerop i) " " (elt w (1- i)))) ;; print w (dotimes (j (1+ (length v))) ;; columns (format t "~3d" (setf (aref matrix i j) (if (and (zerop i) (zerop j)) ;; (setf (aref matrix 0 0) 0) 0 (min* (if (zerop i) ;; don't try to delete in 0th row '+INFINITY (add* (aref-or-infinity matrix (max 0 (- i 2)) j) 1)) ;; remove (add* (aref-or-infinity matrix i (1- j)) 1) ;; insert (add* (aref-or-infinity matrix (1- i) (1- j)) ;; take over (if (and (>= i 1) (>= j 1) ;; exclude zero cols/rows (char-equal (elt v (1- j)) (elt w (1- i)))) 0 '+INFINITY))))))) (format t "~%")) matrix nil)) ;; remove nil if you want this to return the matrix Download
Max-Gerd Retzlaff <m.retzlaff@gmx.net>, <mgr@bl0rg.net>, or <mgr@vantronix.net>
GnuPG- / OpenPGP-Information: Type bits/keyID Date User ID pub 1024/81239F12 2002/03/12 Max-Gerd Retzlaff <mgr@hannover.ccc.de> Key fingerprint = 49 CD 21 F2 41 AC 72 C5 D0 D1 27 DC C2 B2 48 AE 81 23 9F 12 uid Max-Gerd Retzlaff <m.retzlaff@gmx.net> sub 4096g/63E36E39 2002-03-12 local copy of the key
Last modified: Wed Oct 6 20:19:36 CEST 2004
|