Und wieder Stringvergleich

[Bjoerk]

Hab‘ mal Levenshtein probiert. Läuft ganz gut soweit. Ist sicherlich noch ausbaufähig. Dein Beispiel (der CodeName von James Bond?, der Cod%ame *on Ja*es Bond*) hätte hiernach 85 % Übereinstimmung.

Delphi-Quellcode:

function Min3(const X, Y, Z: integer): integer;
begin
  if (X < Y) then
    Result:= X
  else
    Result:= Y; 
  if (Z < Result) then Result:= Z; 
end; 


function LevenshteinDistance(const S1, S2: string; const IgnoreCase: boolean): integer;
var
  Distance: array of array of integer;
  I, J, C, A1, A2, A3, N, M: integer;
  F: boolean;
begin
  N:= Length(S1);
  M:= Length(S2);
  SetLength(Distance, N+1, M+1);
  Distance[0, 0]:= 0;
  for I:= 1 to N do
    Distance[I, 0]:= 1;
  for J:= 1 to M do
  begin
    Distance[0, J]:= Distance[0, J-1]+1;
    for I:= 1 to N do
    begin
      if IgnoreCase then
        F:= (AnsiLowerCase(S1[I]) = AnsiLowerCase(S2[J]))
      else
        F:= (S1[I] = S2[J]);
      if F then
        C:= 0
      else
        C:= 1;
      A1:= Distance[I-1, J-1]+C;
      A2:= Distance[I, J-1]+1;
      A3:= Distance[I-1, J]+1;
      Distance[I, J]:= Min3(A1, A2, A3);
    end;
  end;
  Result:= Distance[N, M]; 
  SetLength(Distance, 0, 0); 
end;


function ImproveString(const S: string): string; 
const
  TCharSet: 
    Set of char = ['a'..'z', '0'..'9', 'A'..'Z',
      'ä', 'ö', 'ü', 'Ä', 'Ö', 'Ü', 'ß', ' ', '_'];
var
  I: integer;
begin
  Result:= '';
  for I:= 1 to Length(S) do
    if S[I] in TCharSet then Result:= Result+S[I]; 
end;


function CopyS(var S: string; I, J: integer): boolean;
begin
  if J > Length(S)-I+1 then
    Result:= false
  else
  begin
    Result:= true; 
    S:= Copy(S, I, J); 
  end; 
end; 


function StringCompare(const S1, S2: string; const IgnoreCase: boolean = true): integer;
var
  Distance, L1, L2: integer;
  T, T1, T2: string;
  I, J: integer;
begin
  T1:= ImproveString(S1);
  T2:= ImproveString(S2);
  if Length(T1) > Length(T2) then
  begin
    T:= T1; T1:= T2; T2:= T;
  end;
  Result:= 0;
  L1:= Length(T1);
  L2:= Length(T2);
  if L1 > 0 then
  begin
    Result:= L2;
    for I:= 1 to L1 do
      for J:= 1 to L1 do
      begin
        T:= T1;
        if CopyS(T, J, I) then
        begin
          Distance:= LevenshteinDistance(T, T2, IgnoreCase);
          // ShowMessage (T+#13+T2+#13+IntToStr(Distance));
          if Distance < Result then Result:= Distance;
        end;
      end;
    Result:= Round(100-100/L2*Result); // Übereinstimmung in %
  end;
end;


procedure TForm1.Button4Click(Sender: TObject);
begin
  ShowMessage ('Übereinstimmung = '+IntToStr(StringCompare(Edit1.Text, Edit2.Text))+' %');
end;