Gesucht: Funktion zur Identifizierung ähnlicher Worte

[sundance]

Hallo zusammen,

ich bin auf der Suche nach einer Funktion, die Strings bzw. Worte vergleichen kann, nicht nur auf Gleichheit, sondern auf Ähnlichkeit (also z.B. sollte "synchronise" und "synchronize" als ähnlich erkannt werden). Nur sollte sie nicht so ungenau zu Werke gehen wie z.B. der SoundEx-Algorithmus. Eine parametrierbare "Unschärfe" beim Vergleich bzw. ein der Ähnlichkeit entsprechender Funktionswert wäre natürlich optimal.

Danke im Voraus
.sundance.


P.S. Ich war mir nicht ganz sicher, in welchen Bereich das hier am besten paßt...

[Bernhard Geyer]

Wenn du dir etwas Arbeit machst (JNI-Integration) so wäre Lucene etwas das das kann.

[sundance]

Hallo Bernhard,

vielen Dank für die Info. Lucene klingt sehr interessant und mächtig, ist aber wohl für meinen Anwendungsfall eher ein "Overkill". Außerdem habe ich eine (subjektive) Abneigung bzgl. Java... :roll:

Auf der Seite www.mosstools.de unter "Ähnlichkeitssuche" habe ich noch eine Borland-DLL gefunden, in der mehrere Ähnlichkeitsfunktionen enthalten sind. Der Autor spricht davon, dass er 3 davon aus der legendären HyperString-Bibliothek entnommen hat, die ich aber leider nirgends mehr finden kann. Ich muß mal testen, ob ich die DLL verwenden kann (ist für VB konzipiert worden...)

.sundance.

[Bbommel]

Du könntest auch mal schauen, ob vielleicht die Levenshtein-Distanz etwas für dich wäre. Die paar Zeilen C-Code lassen sich ja schnell nach Delphi übertragen.

Bis denn
Bommel

Edit: Ich wusste doch, ich hatte das schon mal irgendwann gemacht... :)

Delphi-Quellcode:

function Levenshtein (string1, string2: string): integer;

var matrix: array of array of integer;
    i,j,cost: integer;
    compArray: array[0..2] of integer;

begin
  SetLength(matrix,length(string1)+1,length(string2)+1);

  for I := 0 to length(string1) do
    matrix[i,0]:=i;

  for j := 0 to length(string2) do
    matrix[0,j]:=j;

  for I := 1 to length(string1) do
    for j := 1 to length(string2) do begin
      if string1[i]=string2[j] then
        cost:=0
      else
        cost:=1;

      compArray[0]:=matrix[i-1,j]+1;
      compArray[1]:=matrix[i,j-1]+1;
      compArray[2]:=matrix[i-1,j-1]+cost;
      matrix[i,j]:=MinIntValue(compArray);
    end;
  Result:=matrix[length(string1),length(string2)];
end;

Um ein sinnvolles Ergebnis zu bekommen, könntest du dann das Ergebnis der Funktion noch in Relation zur Anzahl der Zeichen eines der Strings setzen und hättest dann sowas wie ein prozentuale Abweichung.

Edit2: Hier in der CodeLib gibt es auch noch eine Umsetzung.

[sundance]

Hallo Bbommel,

vielen Dank für den Hinweis; der Levenshtein-Algorithmus sieht sehr vielversprechend aus.
Meine ersten Tests funktionieren auch und die Funktion läßt sich problemlos implementieren...

.sundance.

[Sir Rufo]

Es gibt da auch noch eine Suche mit Fuzzy-Logic.

Irgendwo müsste ich auch den Source noch rumfliegen haben.

Wenn ich den finde, dann poste ich den hier mal rein.

gefunden ... im gut sortierten Haushalt kommt ja nix weg :mrgreen:

Delphi-Quellcode:

unit FuzzyString;

interface

function FuzzyMatching( const SearchIn, SearchStr : String ) : extended;

implementation

const
  MaxParLen = 255;

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

function PrepareTheString( const 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( const 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;

    i := 1;
    while i <= 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;
        Inc( i );
      END;

    NGramMatch := Count * NGramLen;
  END;

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

function FuzzyMatching( const SearchIn, SearchStr : String ) : extended;

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

  BEGIN

    BestSim := 0.0;

    if ( SearchIn <> '' ) and ( SearchStr <> '' ) then
      begin
        SearchStrLen := PrepareTheString( SearchStr, SStr );
        NGram1Len := 3;
        IF SearchStrLen < 7 THEN
          NGram2Len := 2
        ELSE
          NGram2Len := 5;

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

        IF TextLen < MaxParLen - 2 THEN
          BEGIN
            MatchCount1 := NGramMatch( TextPara, SStr, SearchStrLen,
              NGram1Len, MaxMatch1 );
            MatchCount2 := NGramMatch( TextPara, SStr, SearchStrLen,
              NGram2Len, MaxMatch2 );
            Similarity := 100.0 * ( MatchCount1 + MatchCount2 ) /
              ( MaxMatch1 + MaxMatch2 );
            IF Similarity > BestSim THEN
              BestSim := Similarity;
          END;
      end;

    RESULT := BestSim;

  END;

end.