home *** CD-ROM | disk | FTP | other *** search
/ TopWare Tools / TOOLS.iso / tools / top1654 / gepackt.exe / LEV2.P < prev    next >
Encoding:
Text File  |  1994-01-26  |  3.8 KB  |  141 lines
  1.  
  2. (****  Gewichtete  Levenshtein-Distanz      ****)
  3. (****  mit Berücksichtigung von Wildcards   ****)
  4. (****  (geschwindigkeitsoptimierte Version) ****)
  5. (****  Ergebnis:  WLD, falls WLD <= limit   ****)
  6. (****             maxlen    sonst           ****)
  7. (****  Autor :  Jörg Michael, Hannover      ****)
  8. (****  Datum :  4. Februar 1993             ****)
  9.  
  10. const maxlen = 50;
  11.       p0 = 1;    (****  Ersetzen  ****)
  12.       q0 = 1;    (****  Einfügen  ****)
  13.       r0 = 1;    (****  Löschen   ****)
  14.  
  15. type  maxstring = string [maxlen];
  16. var   wort,muster, zahl: maxstring;
  17.       limit : integer;
  18.  
  19. function MIN (x,y,z: integer): integer;
  20. begin
  21.   if (x < y) then  y := x;
  22.   if (y < z) then MIN := y else MIN := z
  23. end;
  24.  
  25.  
  26. function isnormal (c: char): boolean;
  27. begin
  28.   if (c <> '*') and (c <> '?')
  29.   then isnormal := true else isnormal := false
  30. end;
  31.  
  32. function WLD (var wort,muster: maxstring; limit: integer):integer;
  33. var  c: char;
  34.     i,j,lw,lm: integer;
  35.     pp,p,q,r: integer;
  36.     d1,d2,spmin: integer;
  37.     d: array [0..maxlen] of integer;
  38.  
  39. begin
  40.   lw := length (wort);
  41.   lm := length (muster);
  42.   spmin := 0;
  43.  
  44.   if (limit = 0) then
  45.     begin
  46.       (****  Anfangsbuchstaben vergleichen  ****)
  47.       if (lm >= 1) and (lw >= 1)
  48.       and (isnormal (muster[1])) and (muster[1] <> wort[1])
  49.          then spmin := maxlen
  50.     end;
  51.  
  52.   if (limit = 1) then
  53.     begin
  54.       (****  die ersten zwei Buchstaben vergleichen  ****)
  55.       if (lm >= 2) and (lw >= 2)
  56.       and (isnormal (muster[1])) and (isnormal (muster[2]))
  57.       and (muster[1] <> wort[1]) and (muster[1] <> wort[2])
  58.       and (muster[2] <> wort[1]) and (muster[2] <> wort[2])
  59.          then spmin := maxlen
  60.     end;
  61.  
  62.   if (spmin <= limit) then
  63.     begin
  64.        (****  Sternchen zählen  ****)
  65.        j := 0;
  66.        for i := 1 to lm do
  67.          begin
  68.            if (muster[i] = '*') then j := j+1
  69.          end;
  70.  
  71.        (****  Wortlängen prüfen  ****)
  72.        i := lm-j -lw;
  73.        if (i * q0 > limit) or ((j = 0) and (i * r0 < -limit))
  74.           then spmin := maxlen
  75.     end;
  76.  
  77.   if (spmin <= limit) then
  78.     begin
  79.       (****  Anfangswerte berechnen  ****)
  80.       if (lm = 0) then
  81.         begin
  82.           for i := 0 to lw do  d[i] := i * r0
  83.         end
  84.       else if (muster[1] = '*') then
  85.         begin
  86.           for i := 0 to lw do  d[i] := 0
  87.         end
  88.  
  89.       else
  90.         begin
  91.           if (muster[1] = '?') then p := 0  
  92.           else p := MIN (p0, p0, r0+q0);
  93.           d[0] := q0;
  94.           d[1] := q0;
  95.           d[2] := q0;
  96.  
  97.           for i := 1 to lw do
  98.             begin
  99.               if (wort[i] = muster[1]) then p := 0;
  100.               d[i] := (i-1) * r0 + p
  101.             end;
  102.           spmin := MIN (d[0], d[1], d[2])
  103.         end
  104.     end;
  105.  
  106.   (****  Distanzmatrix durchrechnen  ****)
  107.   j := 1;
  108.   while (j < lm) and (spmin <= limit) do
  109.     begin
  110.       j := j+1;
  111.       c := muster[j];
  112.       if (c = '*') or (c = '?') then p := 0 else p := p0;
  113.       if (c = '*') then q := 0 else q := q0;
  114.       if (c = '*') then r := 0 else r := r0;
  115.       d2 := d[0];
  116.       d[0] := d[0] + q;
  117.       spmin := d[0];
  118.  
  119.       for i := 1 to lw do
  120.         begin
  121.           (****  d[i] := Minimum dreier Zahlen  ****)
  122.           d1 := d2;
  123.           d2 := d[i];
  124.           if (wort[i] = c)  then pp := 0 else pp := p;
  125.           d[i] := MIN (d1+pp, d2+q, d[i-1]+r);
  126.           if (d[i] < spmin) then spmin := d[i] 
  127.         end
  128.     end;
  129.               
  130.   if (spmin <= limit) and (d[lw] <= limit) 
  131.   then WLD := d[lw] else WLD := maxlen
  132. end;
  133.  
  134. begin
  135.   (****  Hauptprogramm  ****)
  136.   write ('Wort   :  '); readln (wort);
  137.   write ('Muster :  '); readln (muster);
  138.   write ('Limit  :  '); readln (zahl);
  139.   limit := ord (zahl[1]) - ord('0');
  140.   write ('Distanz:  ', WLD (wort,muster, limit))
  141. end.
  142.  
  143.