Ähnlichkeitssuche: Fuzzy-Search-Unit???

[glkgereon]

Delphi-Quellcode:

PROGRAM FuzzySearch; 

VAR Str: String; 
    InputStr : String; 
    SearchStr: String; 
    Treshold : Integer; 

(***************************************************************************) 

FUNCTION PrepareTheString ( OriginStr: String; VAR ConvStr:String): Integer; 

VAR i:Integer; 

BEGIN 
ConvStr:=OriginStr; 

FOR i:=1 TO Length(OriginStr) DO 
   BEGIN 
   ConvStr[i]:=UpCase(ConvStr[i]); 
   IF ConvStr[i]<'0' THEN 
      ConvStr[i]:=' ' 
   ELSE 
      CASE ConvStr[i] OF 
         Chr(196) : ConvStr[i]:=Chr(228); 
         Chr(214) : ConvStr[i]:=Chr(246); 
         Chr(220) : ConvStr[i]:=Chr(252); 
         Chr(142) : ConvStr[i]:=Chr(132); 
         Chr(153) : ConvStr[i]:=Chr(148); 
         Chr(154) : ConvStr[i]:=Chr(129); 
         ':'      : ConvStr[i]:=' '; 
         ';'      : ConvStr[i]:=' '; 
         '<'      : ConvStr[i]:=' '; 
         '>'      : ConvStr[i]:=' '; 
         '='      : ConvStr[i]:=' '; 
         '?'      : ConvStr[i]:=' '; 
         '['      : ConvStr[i]:=' '; 
         ']'      : ConvStr[i]:=' '; 
         END; 
   END; 

PrepareTheString:=i; 
END; 

(***************************************************************************) 
//Marabus Lösung
FUNCTION NGramMatch ( TextPara, SearchStr    : String; 
                      SearchStrLen, NGramLen : Integer; 
                      VAR MaxMatch           : Integer ) : Integer; 

VAR NGram      : String[8]; 
    NGramCount : Integer; 
    i, j, delta, Count   : Integer; 

BEGIN 
  NGramCount:=SearchStrLen-NGramLen+1; 
  Count:=0; 
  MaxMatch:=0; 

delta := 0; 
FOR j:=1 TO NGramCount DO 
    BEGIN 
    i := j + delta; 
    NGram :=Copy(SearchStr,i,NGramLen); 
    IF (NGram[NGramLen-1]=' ') AND (NGram[1]<>' ') THEN 
       Inc(delta, NGramLen-3)    (* Wird in der Schleife noch erhoeht! *) 
    ELSE 
       BEGIN 
       Inc(MaxMatch,NGramLen); 
       IF Pos(NGram,TextPara)>0 THEN 
          Inc(Count); 
       END; 
    END; 

  NGramMatch:=Count*NGramLen; 
END;

(***************************************************************************) 

FUNCTION FuzzyMatching ( SearchStr : String; 
                          Treshold  : Integer; 
                          VAR AllStr: Text ):Matched; 

VAR TextPara     : String; 
    TextBuffer   : String; 
    TextLen      : Integer; 
    SearchStrLen : Integer; 
    NGram1Len    : Integer; 
    NGram2Len    : Integer; 
    MatchCount1  : Integer; 
    MatchCount2  : Integer; 
    MaxMatch1    : Integer; 
    MaxMatch2    : Integer; 
    Similarity   : Real; 
    BestSim      : Real; 

BEGIN 
BestSim:=0.0; 
SearchStrLen:=PrepareTheString(SearchStr,SearchStr); 
NGram1Len:=3; 
IF SearchStrLen<7 THEN 
   NGram2Len:=2 
ELSE 
   NGram2Len:=5; 

  TextLen:=PrepareTheString(AllStr,TextPara) + 1; 
  TextPara:=Concat(' ',TextPara); 

    MatchCount1:=NGramMatch(TextPara, SearchStr, SearchStrLen, NGram1Len, MaxMatch1); 
    MatchCount2:=NGramMatch(TextPara, SearchStr, SearchStrLen, NGram2Len, MaxMatch2); 
    Similarity:=100.0 * (MatchCount1 + MatchCount2) / (MaxMatch1 + MaxMatch2); 
    IF Similarity>BestSim THEN 
       BestSim:=Similarity; 
    IF Similarity>=Treshold THEN 
       BEGIN 
       Writeln; 
       Writeln('[', Similarity, '] ', AllStr); 
       END; 
    END 

Result:=BestSim<Treshold;
END; 

(***************************************************************************) 

BEGIN 
Writeln; 
Writeln('+------------------------------------------+'); 
Writeln('| Unscharfe Suche im Information Retrieval |'); 
Writeln('|         (C) 1997 Reinhard Rapp           |');
Writeln('|      Changed 2005 Gereon Kremer ;-)      |'); 
Writeln('+------------------------------------------+'); 
Writeln; 
Write('zu dursuchender: String'); 
Readln(Str); 
Write('Suchstring: '); 
Readln(InputStr); 
SearchStr:=Concat(' ',InputStr,' '); 
Write('Mindesttrefferguete in % : '); 
Readln(Treshold); 

IF (Treshold>0) AND (Treshold<=100) AND (SearchStr<>'') AND (Str<>'') THEN 
   IF FuzzyMatching( SearchStr, Treshold, Str) THEN Writeln('Tuts') else Writeln('Tuts nicht');   

Writeln; 
Writeln('Tschuess!'); 
END.

was habe ich gemacht?
ich habe die File-Operationen rausgenommen und ein result dazugetan sowie par kleinigkeiten.

is leider schrecklich eingerückt weil einfach sachen rausgelöscht etc...