home *** CD-ROM | disk | FTP | other *** search
/ TopWare Tools / TOOLS.iso / tools / top1654 / gepackt.exe / LEV3.P < prev    next >
Encoding:
Text File  |  1994-01-26  |  3.1 KB  |  107 lines
  1. (****  Adressenvergleich mit Fuzzy Logic   ****)
  2. (****  auf Basis der Levenshtein-Funktion  ****)
  3. (****  Autor :  JÜrg Michael, Hannover     ****)
  4. (****  Datum :  21. August 1993            ****)
  5.  
  6. type  adresse = record
  7.         vorname: maxstring;
  8.         name   : maxstring;
  9.         strasse: maxstring;
  10.         gebtag :  string[2];
  11.         gebmonat: string[2];
  12.         gebjahr:  string[4]
  13.        end;
  14.  
  15. function adressenvergleich (var adr1, adr2: adresse): boolean;
  16. (****  adr1 = zu prƒfende Anschrift      ****)
  17. (****  adr2 = Adresse, die gesucht wird  ****)
  18. (****        (enthèlt evtl. Wildcards)   ****)
  19. (****  (analog zu Wort und Muster        ****)
  20. (****   der Levenshtein-Funktion)        ****)
  21.  
  22. var i,k,punkte: integer;
  23.     ln,lv,ls: integer;
  24. begin
  25.   (****  Vorauswertung :  Wildcards in   ****)
  26.   (****  Name, Vorname und Straºe zèhlen ****)
  27.   (****  (ln,lv,ls = zulèssige Fehler)   ****)
  28.   i := 0;
  29.   ln := length (adr2.name);
  30.   for k := 1 to ln do
  31.     begin
  32.       if (adr2.name[k] = ╒*╒) or (adr2.name[k] = ╒?╒)  
  33.       then i := i+1
  34.     end;
  35.   ln := (ln-i) div 5;
  36.  
  37.   i := 0;
  38.   lv := length (adr2.vorname);
  39.   for k := 1 to lv do
  40.     begin
  41.       if (adr2.vorname[k] = ╒*╒) or (adr2.vorname[k] = ╒?╒)  
  42.       then i := i+1
  43.     end;
  44.   lv := (lv-i-1) div 2;
  45.   if (lv > 3) then lv := 3 else if (lv < 0) then lv := 0;
  46.  
  47.   i := 0;
  48.   ls := length (adr2.strasse);
  49.   for k := 1 to ls do
  50.     begin
  51.       if (adr2.strasse[k] = ╒*╒) or (adr2.strasse[k] = ╒?╒)  
  52.       then i := i+1
  53.     end;
  54.   ls := (ls-i-1) div 3;
  55.   if (ls > 4) then ls := 4 else if (ls < 0) then ls := 0;
  56.  
  57.   (****   Anschriften  vergleichen     ****)
  58.   (****  (4 Punkte sind erforderlich)  ****)
  59.   punkte := 0;
  60.   i := WLD (adr1.name, adr2.name, (** ╒*╒, **) ln);
  61.  
  62.   if (i <= ln) then
  63.     begin
  64.       (****  Vorname prƒfen  ****)
  65.       if (adr1.vorname = ╒╒) or (adr2.vorname = ╒╒)
  66.       then
  67.         begin
  68.           i := lv;
  69.           punkte := punkte + 1
  70.         end
  71.       else
  72.         begin
  73.           i := WLD (adr1.vorname, adr2.vorname, (** ╒*╒, **) lv);
  74.           if (i <= lv-2) then punkte := punkte + 2
  75.           else if (i <= lv) then punkte := punkte + 1
  76.         end;
  77.  
  78.       (****  Geburtstage vergleichen  ****)
  79.       if (adr1.gebtag = adr2.gebtag) and (adr1.gebtag <> ╒╒)
  80.         then punkte := punkte + 1;
  81.       if (adr1.gebmonat = adr2.gebmonat) and (adr1.gebmonat <> ╒╒)
  82.         then punkte := punkte + 1;
  83.       if (adr1.gebjahr = adr2.gebjahr) or (adr1.gebjahr = ╒╒)
  84.         or (adr2.gebjahr = ╒╒)  then punkte := punkte + 1
  85.     end;
  86.  
  87.   if (punkte >= 2) then
  88.     begin
  89.       if (lv+ls <= 1)
  90.       and ((adr1.gebjahr = ╒╒) or (adr2.gebjahr = ╒╒))
  91.       then punkte := punkte + 1;
  92.  
  93.       (****  Straºenname prƒfen  ****)
  94.       if (adr1.strasse = ╒╒) or (adr2.strasse = ╒╒)
  95.       then punkte := punkte + 1
  96.       else
  97.         begin
  98.           k := WLD (adr1.strasse, adr2.strasse, (** ╒*╒, **) ls);
  99.           if (k <= ls-2) then punkte := punkte + 2
  100.           else if (k <= ls) then punkte := punkte + 1;
  101.           if (i = lv-1) and (k = ls-1) then punkte := punkte + 1
  102.         end
  103.     end;
  104.   if (punkte >= 4) then adressenvergleich := true
  105.   else adressenvergleich := false
  106. end;
  107.