home *** CD-ROM | disk | FTP | other *** search
/ TopWare Tools / TOOLS.iso / tools / top1654 / gepackt.exe / LEV1.P < prev    next >
Encoding:
Text File  |  1994-01-26  |  1.5 KB  |  55 lines
  1. (****  Gewichtete Levenshtein-Distanz     ****)
  2. (****  mit Berücksichtigung von Wildcards ****)
  3. (****  -----  Ausgangsversion  -----      ****)
  4. (****  Autor :  Jörg Michael, Hannover    ****)
  5. (****  Datum :  4. Februar 1993           ****)
  6.  
  7. const maxlen = 50;
  8.       p0 = 1;     (****  Ersetzen  ****)
  9.       q0 = 1;     (****  Einfügen  ****)
  10.       r0 = 1;     (****  Löschen   ****)
  11.  
  12. type  maxstring = string [maxlen];
  13. var   wort, muster: maxstring;
  14.  
  15. function MIN (x,y,z: integer): integer;
  16. begin
  17.   if (x < y) then  y := x;
  18.   if (y < z) then MIN := y else MIN := z
  19. end;
  20.  
  21. function WLD (var wort,muster: maxstring): integer;
  22. var  c: char;
  23.     i,j,lw,lm: integer;
  24.     pp,p,q,r: integer;
  25.     d: array [0..maxlen, 0..maxlen] of integer;
  26. begin
  27.   lw := length (wort);
  28.   lm := length (muster);
  29.   d[0,0] := 0;
  30.   for i := 1 to lw do  d[i,0] := d[i-1,0] + r0;
  31.  
  32.   for j := 1 to lm do
  33.     begin
  34.       c := muster[j];
  35.       if (c = '*') or (c = '?') then p := 0 else p := p0;
  36.       if (c = '*') then q := 0 else q := q0;
  37.       if (c = '*') then r := 0 else r := r0;
  38.       d[0,j] := d[0,j-1] + q;
  39.  
  40.       for i := 1 to lw do
  41.         begin
  42.           (****  d[i,j] := Minimum dreier Zahlen  ****)
  43.           if (wort[i] = muster[j])  then pp := 0 else pp := p;
  44.           d[i,j] := MIN (d[i-1,j-1] +pp, d[i,j-1] +q, d[i-1,j] +r)
  45.         end
  46.     end;
  47.   WLD := d[lw,lm] 
  48. end;
  49.  
  50. begin
  51.   (****  Hauptprogramm  ****)
  52.   write ('Wort   :  '); readln (wort);
  53.   write ('Muster :  '); readln (muster);
  54.   write ('Distanz:  ', WLD (wort,muster))
  55. end.
  56.