Einzelnen Beitrag anzeigen

Benutzerbild von leddl
leddl

Registriert seit: 13. Okt 2003
Ort: Künzelsau
1.613 Beiträge
 
Delphi 2006 Professional
 
#24

Re: Ähnlichkeitssuche: Fuzzy-Search-Unit???

  Alt 19. Apr 2005, 11:35
Nein, das war natürlich Mist von mir. So funktioniert das natürlich nicht. Bin darüber heute nacht auch lange gesessen, habe aber nichts endgültiges geschafft.
Ein möglicher Funktionskopf wäre zB so:
function Similarest(aText: string; aList: TStrings; Treshold: Integer; Var aFound : TStrings): Boolean; Damit hast du die Gewissheit, daß die TStrings vom User gehandelt werden müssen. Außerdem bekommt man so als Ergebnis, ob ein String gefunden wurde.
Was die Implementierung mit Treshold (zu deutsch: Schwelle) angeht: Die Distanz der verglichenen Strings läuft intern von 0 bis 50 (50 am schlechtesten, 0 am besten). Daher kann man eben auch nur Werte bis 50 eingeben. Daran hatte ich gestern nacht auch nicht gedacht. Das muß man dann eben dementsprechend überprüfen und ändern. Evtl muß man natürlich auch darauf achten, ob man mit Treshold jetzt die Distanz oder die Qualität betrachtet. Je nachdem muß man natürlich etwas ändern.
Könnte aber so aussehen (wieder mal ungetestet):
Delphi-Quellcode:
function Similarest(aText: string; aList: TStrings; Treshold: Integer; Var aFound : TStrings): Boolean;
var
  Dummy: string;
  MinV : Integer;
  i : Integer;
  FiR0 : Integer;
  FiP0 : Integer;
  FiQ0 : Integer;
  Dist : array of Integer;

  { ---  Similarest: Subprozedure  ------------------------------------------- } 
  procedure LevenshteinPQR(p,q,r:integer);
  begin
    FiP0 := p;
    FiQ0 := q;
    FiR0 := r;
  end; {  LevenshteinPQR  } 


  { ---  Similarest: Subfunktion  -------------------------------------------- } 
  function LevenshteinDistance(const sString,sPattern: String): Integer;
  const
    MAX_SIZE = 50;
  var
    aiDistance: array [0..MAX_SIZE,0..MAX_SIZE] of Integer;
    i,j,
    iP,iQ,iR,iPP,
    iStringLength,
    iPatternLength,
    iMaxI,iMaxJ : Integer;
    chChar : Char;

    function Min(X,Y,Z: Integer): Integer;
    begin
      if (X<Y) then
        Result:=X
      else
        Result:=Y;
      if (Result>Z) then
        Result:=Z;
    end; {  Min  } 

  begin
    iStringLength:=length(sString);
    if (iStringLength>MAX_SIZE) then
      iMaxI:=MAX_SIZE
    else
      iMaxI:=iStringLength;
    iPatternLength:=length(sPattern);
    if (iPatternLength>MAX_SIZE) then
      iMaxJ:=MAX_SIZE
    else
      iMaxJ:=iPatternLength;

    aiDistance[0, 0]:=0;
    for i:=1 to iMaxI do
      aiDistance[i, 0]:=aiDistance[i-1, 0]+FiR0;
    for j:=1 to iMaxJ do begin
      chChar:=sPattern[j];
      if ((chChar='*') or (chChar='?')) then
        iP:=0
      else
        iP:=FiP0;
      if (chChar='*') then
        iQ:=0
      else
        iQ:=FiQ0;
      if (chChar='*') then
        iR:=0
      else
        iR:=FiR0;

      aiDistance[0, j]:=aiDistance[0, j-1]+iQ;

      for i:=1 to iMaxI do begin
        if (sString[i]=sPattern[j]) then
          iPP:=0
        else
          iPP:=iP;
        {*** aiDistance[i,j] := Minimum of 3 values ***} 
        aiDistance[i,j]:=Min(aiDistance[i-1, j-1]+iPP,
                             aiDistance[i, j-1] +iQ,
                             aiDistance[i-1, j] +iR);
      end;
    end;
    Result:=aiDistance[iMaxI, iMaxJ];
  end; {  LevenshteinDistance  } 
begin
  //Treshold von 0-50
  Treshold := max(Treshold,0);
  Treshold := min(Treshold,50);

  SetLength(Dist, aList.Count);
  LevenshteinPQR(1, 1, 1);

  for i := 0 to (aList.Count-1) do
  begin
    //Dummy := ExtractFileName(aList.Strings[i]);
    //Dummy := Copy(Dummy, 1, Pos('.', Dummy)-1);
    Dummy := aList.Strings[i];

    Dist[i] := LevenshteinDistance(aText, Dummy);
  end;

  for i := 0 to (Length(Dist)-1) do
    if (Dist[i] < Treshold) then aFound.Items.Add(aList[i]);

  Result := aFound.Count > 0;
end;
Treshold gibt jetzt hier die maximale Distanz der Ergebnisse an!
Axel Sefranek
A programmer started to cuss, cause getting to sleep was a fuss.
As he lay there in bed, looping round in his head
was: while(!asleep()) ++sheep;
  Mit Zitat antworten Zitat