Ähnlichkeitssuche: Fuzzy-Search-Unit???

[romber]

Hallo!

Habe hier im Forum einen Link gefunden zu einem kleinen Test-Program, der ubereinstimmende sowie ähnliche Suchbegriffe im Text findet. Fuzzy-Search-Unit. Der Unit ist als eine Konsole-Anwendung geschrieben. Kann mir jemand helfen, diese Funktion so zu ändern, dass ich den Text in einem Memo durchsuchen kann und als result True oder False zurückgeben? Habe schon mehrmals selbst verucht, aber komme mir diversen Fehlermeldungen nicht klar :wall:

Danke!

[romber]

Vielleicht ist jemand zu faul, um die ZIP-Datei mit dem Code herunter zu laden, entpacken und in Delphi zu öffnen (nett gemeint :wink: ), deswegen hier den Inhalt der Fuzzy-Unit:

Delphi-Quellcode:

PROGRAM FuzzySearch;

CONST MaxParLen = 255;

VAR InFile   : Text;
    Filename : 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;

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

FUNCTION NGramMatch ( TextPara, SearchStr    : String;
                      SearchStrLen, NGramLen : Integer;
                      VAR MaxMatch           : Integer ) : Integer;

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

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

FOR i:=1 TO NGramCount DO
    BEGIN
    NGram:=Copy(SearchStr,i,NGramLen);
    IF (NGram[NGramLen-1]=' ') AND (NGram[1]<>' ') THEN
       Inc(i,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;

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

PROCEDURE FuzzyMatching ( SearchStr : String;
                          Treshold  : Integer;
                          VAR InFile: Text );

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;

WHILE NOT Eof(InFile) DO
   BEGIN
   Readln(InFile,TextBuffer);
   TextLen:=PrepareTheString(TextBuffer,TextPara) + 1;
   TextPara:=Concat(' ',TextPara);

   IF TextLen<MaxParLen-2 THEN
      BEGIN
      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, '] ', TextBuffer);
         END;
      END
   ELSE
      Writeln('Absatz zu lang!');
   END;

IF BestSim<Treshold THEN
   Writeln('Kein Treffer; Best Match war ', BestSim);
END;

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

BEGIN
Writeln;
Writeln('+------------------------------------------+');
Writeln('| Unscharfe Suche im Information Retrieval |');
Writeln('|         (C) 1997 Reinhard Rapp           |');
Writeln('+------------------------------------------+');
Writeln;
Write('Name der zu durchsuchenden Datei: ');
Readln(Filename);
Write('Suchstring: ');
Readln(InputStr);
SearchStr:=Concat(' ',InputStr,' ');
Write('Mindesttrefferguete in % : ');
Readln(Treshold);

IF (Treshold>0) AND (Treshold<=100) AND (SearchStr<>'') AND (Filename<>'') THEN
   BEGIN
   Assign( InFile, Filename);
   Reset( InFile );
   FuzzyMatching( SearchStr, Treshold, InFile);
   Close( InFile );
   END;

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

Ich habe versucht, Funktionen zu kopieren und mit ein Paar Änderungen eine Test-Anwendung zu erstellen. Kann aber nicht testen, weil immer einen Compiler-Error an dieser Stelle bekomme:

Delphi-Quellcode:

...
Inc(i,NGramLen-3)
...

[Error] Unit1.pas(76): Assignment to FOR-Loop variable 'i'

und kann trotz Delphi-Referenz nicht kapieren, was es bedeuted. :shock:

Bitte, hilft mir die Code wie oben beschrieben zu medernisieren. Ich bin den ganzen Tag dabei und leider ohne Erfolg. :(

Danke im Voraus!

[leddl]

Frage: Kannst du den Code so compilieren, wie er ist? Also die Konsolen-Anwendung? :shock:

Der Fehler ist nämlich ganz logisch. In Delphi ist es IMHO nicht möglich, die Schleifenariable einer For-Schleife noch innerhalb der Schleife zu verändern. Das soll verhindern, daß man mit den Indizes irgendeinen Unfug macht. ;) Wo das unbedint benötigt wird, solltest du eine While-Schleife verwenden.

Ich weiß nicht, ob das früher mal ging, kann ja sein, daß das in Delphi 3 oder so noch funktionierte und die Anwendung da geschrieben wurde. Also einfach die For-Schleife umbasteln, dann sollte es funktionieren.

Delphi-Quellcode:

i := 1;
While i <= NGramCount DO 
    BEGIN 
    NGram:=Copy(SearchStr,i,NGramLen); 
    IF (NGram[NGramLen-1]=' ') AND (NGram[1]<>' ') THEN 
       Inc(i,NGramLen-3) 
    ELSE 
       BEGIN 
       Inc(MaxMatch,NGramLen); 
       IF Pos(NGram,TextPara)>0 THEN 
          Inc(Count); 
       END; 
    END; 
  inc(i);
  NGramMatch:=Count*NGramLen; 
END;

[romber]

Die Konsole-Programm funktioniert wunderbar. Ich probiere mal jetzt mal mit der veränderten Schleife.

[romber]

Ich komme nicht weiter klar. Ich brauche diese Funktion so dringend, dass ich gerne dafür bezahle. Wenn jemand interesse hat, bitte eine private Nachricht senden, dann können wir den Honorar festlegen.

[marabu]

Hier eine Standard-Umformung für das Problem mit der abgesicherten Laufvariablen.

Delphi-Quellcode:

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;

Have fun.

[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...

[Catbytes]

Hallo,

http://www.factfinder.de/

Was besseres findest Du nirgends.

[leddl]

Ich verstehe nicht ganz, wo denn jetzt das Problem liegt... :gruebel:
Geht keine der hier geposteten Methoden? Falls nicht, mit welcher Fehlermeldung stoppt der Compiler?
Es macht doch keinen Sinn, wenn jetzt hier wild 1000 verschiedene Lösungen gepostet werden, ohne daß man weiß, was denn nun nicht geht.

[romber]

Erstmal Vielen Dank an alle, dir hier versuchen, mir zu helfen. Aber keine der bis jetzt geposteten Lösungen funktioniert, leider. Die Variante von glkgereon könnte ich nicht testen weil Delphi keine Ahnung hat (sowie ich auch, aber das ist bestimmt nicht maßgebend) was "Matched" fur ein Variable-Typ ist. :gruebel:

Zitat:

Zitat von glkgereon

Delphi-Quellcode:

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

Außerdem, wenn ich es richtig verstehe, sind die geposteten Lösungen immer noch eine Konsole-Anwendung oder ein Teil davon.