(****************************************************************************
:Program.       Levenshtein.mod
:Contents.      Routines to compare strings
:Author.        Richard Günther [gvm]
:Address.       HeilbronnerStr.267, 7410 Reutlingen
:Phone.         07121/66432
:Copyright.     Freeware
:Language.      Oberon
:Translator.    AmigaOberon v2.14d
:History.       V1.0 [gvm] 01-Jan-92  first implementation
:Bugs.          none known, string length max. 64 chars (4KB buffer !)
****************************************************************************)

(* $NilChk- $ReturnChk- *)
MODULE Levenshtein ;

IMPORT  SYSTEM,
        O : OberonLib,
        S : Strings ;

CONST insert=1 ; delete=1 ; replace=2 ;

VAR  Buffer  : POINTER TO ARRAY 64,64 OF SHORTINT ; (* larger sizes do not work *)
                                              (* because of shortint overflow ! *)

(* $EntryExitCode- *)
PROCEDURE Minimum(x{2},y{1},z{0} : SHORTINT): SHORTINT ;
BEGIN
  SYSTEM.INLINE(0B202H,   (*    CMP.B   x,y       *)
                06D02H,   (*    BLT.S   aa        *)
                01202H,   (*    MOVE.B  x,y       *)
                0B001H,   (* aa CMP.B   y,z       *)
                06D02H,   (*    BLT.S   bb        *)
                01001H,   (*    MOVE.B  y,z       *)
                04E75H) ; (* bb RTS               *)
END Minimum ;

(* $CopyArrays- $ClearVars- $OvflChk- $RangeChk- *)
PROCEDURE LDistance*(string1,string2    : ARRAY OF CHAR): INTEGER ;

VAR len1,len2 : INTEGER ;
    x,y       : INTEGER ;

  PROCEDURE Replace(x,y : INTEGER): SHORTINT ;
  BEGIN
    IF string1[x]=string2[y] THEN RETURN 0
    ELSE RETURN replace END ;
  END Replace ;

BEGIN
  len1:=S.Length(string1) ; len2:=S.Length(string2) ;
  IF (len1>63) OR (len2>63) THEN RETURN -1 END ;
  Buffer[0,0]:=0 ;
  x:=1 ; y:=1 ;
  REPEAT                                (* Datenfeld vorbereiten (x-Werte) *)
    Buffer[x,0]:=Buffer[x-1,0]+delete ;
    INC(x) ;
  UNTIL x>len1 ;
  REPEAT                                (* Datenfeld vorbereiten (y-Werte) *)
    Buffer[0,y]:=Buffer[0,y-1]+insert ;
    INC(y) ;
  UNTIL y>len2 ;
  x:=1 ;
  REPEAT
    y:=1 ;
    REPEAT
      Buffer[x,y]:=Minimum(Buffer[x-1,y-1] + Replace(x-1,y-1),
                           Buffer[x  ,y-1] + insert,
                           Buffer[x-1,y  ] + delete) ;
      INC(y) ;
    UNTIL y>len2 ;
    INC(x) ;
  UNTIL x>len1 ;
  RETURN Buffer[len1,len2] ;
END LDistance ;


BEGIN
  NEW(Buffer) ;                     (* Der Buffer belegt konstant 4 KB! *)
  IF Buffer=NIL THEN HALT(20) END ;
CLOSE
  IF Buffer#NIL THEN DISPOSE(Buffer) END ;
END Levenshtein.