Strings auf Ähnlichkeit überprüfen

[Gambit]

Hallo,
ich möchte zwei Strings auf Ähnlichkeit überprüfen.
Dabei soll ausgegeben werden zu wieviel Prozent sich die Strings ähneln.
Dazu splitte ich die Strings zunächst in die enthaltenen Wörter und schreibe sie in jeweils eine ListBox. Danach prüfe ich nach, zu wieviel Prozenz die Wörter aus dem ersten String im zweiten enthalten sind und nutze dazu auch die SoundexSimillar Funktion um Rechtschreibfehler soweit möglich auszuschließen. Am Schluss prüfe ich noch zu wieviel Prozent die Wörter aus dem ersten String im zweiten enthalten sind:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var i, j, SimillarWordsCounter: Integer;
begin
  ListBox1.Items:= filter(PChar(Edit1.Text));
  ListBox2.Items:= filter(PChar(Edit2.Text));

  for i:= 0 to ListBox1.Items.Count-1 do
  begin
    for j:= 0 to ListBox2.Items.Count-1 do
    begin
      if SoundExSimilar(ListBox1.Items.Strings[i], ListBox2.Items.Strings[j], 4) then
      SimillarWordsCounter:= SimillarWordsCounter+1;
    end;
  end;
  showMessage('Strings ähneln sich zu '+
              IntToStr(((SimillarWordsCounter div ListBox1.Items.Count * 100)
              +(ListBox1.Items.Count+ListBox2.Items.Count)div 2*100)div 2)+ ' %') ;
end;

function filter(source:PChar):TStringList;
var p, start   : PChar;
    token      : string;
begin
  result := TStringList.Create;
  p := source;
  while (p^ <> #0) do begin
     if p^ in [#1..#64,#91..#96,#123..#127] then Inc(p)
     else begin                 // ein Wort wurde gefunden ...
       start := p;
       while not (p^ in [#0..#64,#91..#96,#123..#127]) do Inc(p);
       SetString(token, start, p-start);
       result.Add(token)
     end
  end
end;

Vielleicht hat ja jemand 'ne Anregung, in wie weit man die Prüfung noch verbessern könnte. Außerdem bin ich mir nicht sicher, ob die statistische Auswertung in showMessage so OK ist.

Gruß

Gambit

[Binärbaum]

Zitat:

Zitat von Gambit

ich möchte zwei Strings auf Ähnlichkeit überprüfen.

Schau dir dazu doch mal die Levenshtein-Distanz an. Das wäre ein möglicher Ansatz, um zwei Strigs auf Ähnlichkeit zu überprüfen.

MfG
Binärbaum

[schuetze09]

@Gambit:
Hallo, vielleicht hilft dir das Fuzzy-Search-Unit
(Textsuche mit unscharfer Logik. Sie findet nicht nur übereinstimmende, sondern auch ähnliche Textstellen)

MfG
schuetze09

[mirage228]

Hi,

Delphi hat die Funktion SoundEx in der Unit "StrUtils", die imho auch mit dem Levenshtein Verfahren arbeitet.

mfG
mirage228

[Gambit]

ich arbeite doch schon mit SoundEx(siehe oben...)