![]() |
Ähnlichkeitssuche: Fuzzy-Search-Unit???
Hallo!
Habe hier im Forum einen Link gefunden zu einem kleinen Test-Program, der ubereinstimmende sowie ähnliche Suchbegriffe im Text findet. ![]() Danke! |
Re: Ähnlichkeitssuche: Fuzzy-Search-Unit???
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:
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:
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.
Delphi-Quellcode:
[Error] Unit1.pas(76): Assignment to FOR-Loop variable 'i'
...
Inc(i,NGramLen-3) ... 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! |
Re: Ähnlichkeitssuche: Fuzzy-Search-Unit???
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; |
Re: Ähnlichkeitssuche: Fuzzy-Search-Unit???
Die Konsole-Programm funktioniert wunderbar. Ich probiere mal jetzt mal mit der veränderten Schleife.
|
Re: Ähnlichkeitssuche: Fuzzy-Search-Unit???
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.
|
Re: Ähnlichkeitssuche: Fuzzy-Search-Unit???
Hier eine Standard-Umformung für das Problem mit der abgesicherten Laufvariablen.
Delphi-Quellcode:
Have fun.
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; |
Re: Ähnlichkeitssuche: Fuzzy-Search-Unit???
Delphi-Quellcode:
was habe ich gemacht?
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. ich habe die File-Operationen rausgenommen und ein result dazugetan sowie par kleinigkeiten. is leider schrecklich eingerückt weil einfach sachen rausgelöscht etc... |
Re: Ähnlichkeitssuche: Fuzzy-Search-Unit???
|
Re: Ähnlichkeitssuche: Fuzzy-Search-Unit???
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. |
Re: Ähnlichkeitssuche: Fuzzy-Search-Unit???
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:
|
Re: Ähnlichkeitssuche: Fuzzy-Search-Unit???
ach sch****
es soll zurückgeben, ob es gematched hat, also ob der string drin war. der typ is natürlich boolean. das is einer meiner häufigsten fehler :wall: Zitat:
und die 2 zeilen wo geprüft wird ob der aufruf gültig ist solltest du noch mitnehmen... |
Re: Ähnlichkeitssuche: Fuzzy-Search-Unit???
Das hier war auch mein Problem:
Delphi-Quellcode:
[Error] Project1.dpr(105): Incompatible types: 'String' and 'Text'
...
TextLen:=PrepareTheString(AllStr, TextPara) + 1; ... |
Re: Ähnlichkeitssuche: Fuzzy-Search-Unit???
Also das Einsetzen in dein Programm sollte doch kein Problem sein... So wie ich das verstanden habe, hast du es doch auch schon gemacht, aber die For-Schleife machte Probleme, oder? :wiejetzt:
Was genau funktioniert denn jetzt zB an dem von mir gepostetem Code-Teil nicht? //Edit: Ich hab jetzt aus reiner Neugier doch mal mein Delphi angeschmissen. Die 2005 Personal compiliert mir die Konsolenanwendung in der Ursprungsfassung nicht - ebenfalls mit Verweis auf die Erhöhung der Schleifenvariablen. So und nicht anders hatte ich es erwartet. Setze ich meine Funktion (mit einer kleinen Änderung allerdings - der Code war furchtbar formatiert und ich hab doch glatt das inc(i) an die falsche Stelle gesetzt! :wall: Einfach eine Zeile nach oben verschieben, dann stimmts) ein, dann compiliert es. //Edit2: Wo genau tritt der Fehler denn jetzt auf? In der Konsolenanwendung oder wenn du versuchst, das umzubauen? Mit solchen Codeschnipseln kann man nichts anfangen. Poste doch einfach mal, was du hast, dann sieht man mehr. |
Re: Ähnlichkeitssuche: Fuzzy-Search-Unit???
Die Schleife war leider nicht da einzige Problem. Das Programm ist nach wie vor für eine gleadene Textdatei otimiert, und meine Versuche, einen String statt Textdatei zu übergeben scheiterten mit der oben geposteten Kompeiler-Fehlermeldung. Mann kann eigentlich hier sehr lange diskutieren. Kann jemand von Speziealisten hier vielleicht so nett sein und diesen kleinen Unit komplett fur Form-Anwendung umzuschreiben? Ich lese hier, dass es eigentlich ganz eifach ist. Einmal den kompletten fertigen Unit hier posten und alle sind zufrieden. Dann könnte man das auch der Code-Library hinzufügen, weil diese Fuzzy-Search an sich eine sehr hilfreiche Sache ist.
Function FuzzyMatching (Suchbegriff: string; Uebereinstimmung: integer; Quelle: string): Boolean; und das war's. |
Re: Ähnlichkeitssuche: Fuzzy-Search-Unit???
Zitat:
Diverse Fehler erscheinen, wenn ich versuche den Unit umzubauen. Mit diesen ganzen TextBuffer, InFile vom Typ Text, ReadLn, WriteLn etc... Meine Kenntnisse sind leider nicht ausreichend, um das Problem selbst zu lösen. Deswegen bin ich auch hier. |
Re: Ähnlichkeitssuche: Fuzzy-Search-Unit???
Sorry, dafür hab ich im Moment gerade keine Zeit. Aber so schwer is das nun wirklich auch nicht. Du mußt einfach nur die Datei InFile durch deinen String ersetzen - dann natürlich auch die Aufrufe dementsprechend ändern - und die Ausgaben an die Konsole sinnvoll in Rückgabewerte umwandeln.
Vielleicht schaff ichs heut nacht mal, mich da dran zu setzen. |
Re: Ähnlichkeitssuche: Fuzzy-Search-Unit???
Diese Funktionen benutze ich dafür...
Läuft im Endeffekt aufs selbe hinaus! Wo ich die herhabe weiß ich leider nciht mehr genau, aber hier im DP-Forum wurde mir nen Link gegeben...
Delphi-Quellcode:
var
FiR0 : integer; FiP0 : integer; FiQ0 : integer; procedure LevenshteinPQR(p,q,r:integer); begin FiP0 := p; FiQ0 := q; FiR0 := r; end; 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; Aufrufen muss man erst die "Init" mit LevenshteinPQR(1, 1, 1); und dann kannste mit LevenshteinDistance(String1,string2)<=fuzzyEntfern ung die Entfernung der Stirngs herausbekommen |
Re: Ähnlichkeitssuche: Fuzzy-Search-Unit???
So, mir platzt gleich der kragen!!!
WO IST MEINE VERSION AUF EINE TEXTDATEI OPTIMIERT????? :evil: nimm sie und sag was net funzt! aber meine version die ich gepostet hab hat sowohl die while-schleife drin als auf die änderung auf string. WAS BITTE WILLST DU MEHR VON UNS???? :evil: |
Re: Ähnlichkeitssuche: Fuzzy-Search-Unit???
:gruebel: War ich das? :gruebel: :mrgreen: Glaub schon, oder? Zumindest benutz ich die auch und hab sie auch mal hier irgendwo gepostet. Von wem ich die Funktion hab, weiß ich auch nicht mehr, aber sie funktioniert ganz gut.
Wollte das hier aber nicht posten, da er ja eigentlich eben die FuzzySearch benutzen wollte... ne Moment mal, hat er ja so gar nich gesagt... er hat halt nur die gefunden. Dann kann man den Levenshtein nur empfehlen. Funktioniert wie gesagt wunderbar. ... So, hab gekramt und mal meine Funktion rausgesucht. Is im Endeffekt das gleiche, nur hab ich das alles innerhalb einer Gesamtfunktion zusammengefasst, so daß nur noch ein Aufruf benötigt wird. Die folgende Funktion benötigt als Parameter den zu suchenden String und eine TStrings. Der Rückgabewert ist dann der Index des ähnlichsten TStrings-Elements. Die Funktion läßt sich natürlich nach Belieben anpassen, mir hat sie so aber ganz gute Dienste erwiesen.
Delphi-Quellcode:
Ich möchte aber auch nochmal darauf hinweisen, daß diese Funktion nicht von mir stammt. Leider hab ich wie gesagt, vergessen, wo ich sie herhabe. Falls das also jemandem bekannt vorkommt, soll er mir bescheid sagen. Dann kann ich auch gerne einen kleinen Vermerk einfügen. ;)
{ --- Sucht in einer Liste nach dem ähnlichsten Text ----------------------- }
function Similarest(aText: string; aList: TStrings): Integer; 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 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; MinV := 0; for i := 0 to (Length(Dist)-1) do if (Dist[MinV] > Dist[i]) then MinV := i; Result := MinV; end; @glkgereon: Sachte sachte! ;) Er hat sichs wohl nich richtig angeschaut. Ich übrigens auch nicht. :oops: Aber Respekt, du warst uns allen voraus. :thumb: |
Re: Ähnlichkeitssuche: Fuzzy-Search-Unit???
Hallo leddl!
Habe Deinen Code getestet. Aber das Ergebnis von Similarest ist bei mir immer gleich 1. Wie krige ich die Asgabe der gefundenen Textstellen hin. Diese können ja dann auch in eine Stringliste zeilenweise übernommen werden. schöni |
Re: Ähnlichkeitssuche: Fuzzy-Search-Unit???
Hm, komisch. Bei mir hat das immer ganz gut funktioniert. Sicher, daß der gesuchte Begriff auch enthalten ist? Vielleicht hast du halt immer als 2. Item einen recht ähnlichen String.
//Edit: Also weil du mich jetzt verunsichert hast, hab ich mich hingehockt und es mal ausprobiert. Funktioniert bei mir immer noch genau so, wie es soll. Selbst bei Verunstaltung der Wörter bekomme ich immer noch den richtigen Index angezeigt. //Edit2: Mist, jetzt hab ich grade erst deinen Zusatz gesehen. OK, dann halt noch ein Edit. :mrgreen: Was meintest du damit? Die Ausgabe bekommst du hin, indem du aus den TStrings denjenigen ausliest, dessen Index zurückgeliefert wird. Levenshtein liefert dir immer nur ein - das beste - Ergebnis zurück und nicht mehrere, falls du das wolltest. Evtl kann man den Algorithmus aber auch so umbügeln, daß er alle Strings, die eine geringere Distanz als x haben in ein TStrings packt und zurückgibt. Sollte auch nicht allzuviel Aufwand bereiten.
Delphi-Quellcode:
Ungetestet, sollte aber funktionieren.
function Similarest(aText: string; aList: TStrings; Treshold: Integer): TStrings;
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 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 Result.Items.Add(aList[i]); //Evtl hier noch zur Data-Eigenschaft die Distanz hinzufügen end; |
Re: Ähnlichkeitssuche: Fuzzy-Search-Unit???
Hallo!
Nochmal vielen Dank für eure Mühe, werde mir die Lösungen jetzt mal anschauen. |
Re: Ähnlichkeitssuche: Fuzzy-Search-Unit???
Hallo Leddl!
Habe Deine zweite Version mit TStrings als Ergebnistyp runtergeladen. Krige aber Zugriffsverletzung. Ist Thershold die von mir gewünschte prozentuale Übereinstimmung? Dann müßte ich ja dort einen Wert zwischen 1 und 100 eingeben. Zitat:
Hier mein Quelltext. Die Funktion Similarest habe ich in MatchList umbenannt. Den Algo habe ich unverändert übernommen:
Delphi-Quellcode:
Was mache ich falsch?
unit Levsearch;
interface uses SysUtils, Classes; function MatchList(aText: string; aList: TStrings; Treshold: Integer): TStrings; implementation {$I Version.inc} {$ifdef Delphi1To3} //Da ich das ganze mit Delphi3 mache, habe ich das dynamische Array für die Variable Dist //wie folgt, definiert: type TDynamicIntegerArray = class(TStringList) //Ist halt ne gut implementierte Liste private procedure setContents(Index,value: Integer); function getContents(Index: Integer): Integer; public constructor Create; constructor Dim(value: Integer); property Contents[Index: Integer]: Integer read getContents write setContents; default; end; constructor TDynamicIntegerArray.Create; begin inherited Create; end; constructor TDynamicIntegerArray.Dim(value: Integer); var i: Integer; begin for i:=1 to value do Add(IntToStr(0)) end; procedure TDynamicIntegerArray.setContents(Index,value: Integer); begin if value <> StrToInt(Strings[Index]) then Insert(Index,IntToStr(Value)); end; //Die Umwandlungen StrToInt u. IntToStr sind halt drin, weil ich mit ner Stringliste //Integerwerte speichern und bearbeiten will. Nicht optimal, aber funzt erst mal. //Kann später noch verbessert werden. function TDynamicIntegerArray.getContents(Index: Integer): Integer; begin Result := StrToInt(Strings[Index]); end; {$endif} function MatchList(aText: string; aList: TStrings; Treshold: Integer): TStrings; var Dummy: string; MinV : Integer; i : Integer; FiR0 : Integer; FiP0 : Integer; FiQ0 : Integer; {$ifdef Delphi1To3} //Dist : TDynamicIntegerArray; {$else} Dist : array of Integer; {$endif} ResultList : TStringList; { --- MatchList: Subprozedure ------------------------------------------- } procedure LevenshteinPQR(p,q,r:integer); begin FiP0 := p; FiQ0 := q; FiR0 := r; end; { LevenshteinPQR } { --- MatchList: 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 ResultList := TStringList.Create; //Vorher Zugriffsverletzung, was ja der Gegenstand meiner Frage ist 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 {$ifdef Delphi1To3} Dist := TDynamicIntegerArray.Dim(aList.Count); //Dim ist Constructor {$else} SetLength(Dist, aList.Count); {$endif} 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; {$ifdef Delphi1To3} for i := 0 to Dist.Count-1 do {$else} for i := 0 to (Length(Dist)-1) do {$endif} if (Dist[i] < Treshold) then ResultList.Add(aList[i]); //Jetzt kommt hie ein EStringListError. Wieso das denn? Hab doch die Liste erzeugt //Evtl hier noch zur Data-Eigenschaft die Distanz hinzufügen Result := ResultList; end; end. //Und nun mein Testformular: {$i version.inc} //Hier stehen Definitionen, die die Delphiversionen voneinander unterscheiden //Da steht auch der Wert Delphi1To3 drin unit winSearch; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, LevSearch, Buttons, StdCtrls; type TForm1 = class(TForm) edSearch: TEdit; Label1: TLabel; Memo: TMemo; //Damit will ich die gefundenen Zeilen anzeigen SpeedButton1: TSpeedButton; procedure SpeedButton1Click(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private-Deklarationen } InpStr: TStringList; public { Public-Deklarationen } end; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.SpeedButton1Click(Sender: TObject); var Elements: TDynamicIntegerArray; Matchs: TStrings; begin // In der folgenden Anweisung krieg ich auch ne Zugriffsverletzung // Memo.Lines.AddStrings(MatchList(edSearch.Text, InpStr, 40)); // ShowMessage('Diatanz = '+IntToStr(Similarest(edSearch.Text,InpStr))); // Similarest zegt bei mir Distanz = 1 an Suchbegriff "Wasser" Matchs := MatchList(edSearch.Text, InpStr, 20); ShowMessage('Anzahl Elemente: ' + IntToStr(Dist.Count)); //HIER ZUGRIFFSVERLETZUNG //WARUM??? end; procedure TForm1.FormCreate(Sender: TObject); begin InpStr := TStringList.Create; //Die Stringliste mit dem zu durchsuchenden Text InpStr.Add('Das Wasser ist warm'); InpStr.Add('Wasserleitung'); InpStr.Add('Wasser, das aus der Wasserleitung kommt, hat Trikwasserqualität'); InpStr.Add('Im Sommer bade ich an liebsten in kühlem Wasser'); end; end. Während ich das schreibe fällt mir doch ein, dass in MatchList die Ergebnisstringliste noch gar nich erzeugt wurde. Damit erklär ich mir die Zugriffsverletzung. Das ich aber jetzt EStringlistError erhalte, leuchtet mir nicht ein. Kannst Du, Leddl, oder ein danderer von Euch helfen? schöni |
Re: Ähnlichkeitssuche: Fuzzy-Search-Unit???
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:
Delphi-Quellcode:
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.
function Similarest(aText: string; aList: TStrings; Treshold: Integer; Var aFound : TStrings): Boolean;
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:
Treshold gibt jetzt hier die maximale Distanz der Ergebnisse an!
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; |
Re: Ähnlichkeitssuche: Fuzzy-Search-Unit???
Hallo Leddl!
Erst mal Danke für die Änderung. Keine Exception mehr. Jetzt findet der Algo aber immer die ersten beiden Zeilen der Eingabeliste. Beispiel: Suchwort "Sommer" Suchergebnis: Das Wasser ist warm Wasserleitung' Wenn ich Wasser eingebe, wär das ja richtig. Aber bei "Sommer" erwarte ich als Ergebnis: Im Sommer bade ich an liebsten in kühlem Wasser Hier noch mal mein Eingabetext, der durchsucht wird: Das Wasser ist warm Wasserleitung Wasser, das aus der Wasserleitung kommt, hat Trikwasserqualität Im Sommer bade ich an liebsten in kühlem Wasser Wenn ich als Suchbegriff "Baden" eingebe, erhalte ich auch die ersten beiden Zeilen, in denen das Wort Bad, baden o.ä. gar nicht vorkommt. So wie ich den Algo verstehe, nimmt er je Textzeile einige Buchstaben meiner Mustereingabe und vergleicht diese mit je einer Zeile des durchsuchten Textes. Semantische Zusammenhänge werden so nicht erkannt. Sonst wäre "Das Wasser ist warm" ja als Treffer zu werten, da im Sommer das Wasser warm ist. Aber wenn nur Buchstaben verglichen werden? Irgendwas stimmt noch nicht! Auch wenn ich das Wort "Trinkwasserqualität" eingebe, erhalte ich die oben genannte Ausgabe. schöni |
Re: Ähnlichkeitssuche: Fuzzy-Search-Unit???
Hallo Leddl!
Im Test hatte ich Treshold = 25 Bei Treshold = 0 findet er gar nix. Bei Treshold = 42 findet er neben den ersten beiden Zeilen noch die folgende Zeile, was ja schon mal gut aussieht: Im Sommer bade ich an liebsten in kühlem Wasser Gibt es einen Optimalen Wert für Treshold? Ich werde inzwischen mal mit unterschiedlichen Werten experimentieren. Erst mal Danke für die bisherige Hilfe schöni |
Re: Ähnlichkeitssuche: Fuzzy-Search-Unit???
Wie gesagt, ich hatte meine Abänderung weder getestet, noch habe ich den ursprünglichen Algorithmus geschrieben. Daher ist das ganze natürlich sehr fehleranfällig. Außerdem hab ich mir für die Überarbeitung auch nicht gerade viel Zeit gelassen. Das war eher so hopplahopp. ;)
Semantische Zusammenhänge kann dieser Algorithmus auf gar keinen Fall erkennen. Ich denke, für so etwas bräuchte man dann schon eine "etwas" umfangreichere Implementierung. ;) Versuch mal, die Funktion nur mit einzelnen Wörtern als Items zu füttern. Soweit ich das verstehe, überprüft er nämlich das Item als solches, und nicht auch Teile als solches. Übergibst du ganze Zeilen, hast du dann nämlich das Problem, daß eine längere Zeile natürlich auch eine Übereinstimmung mit größerer Distanz ergibt, selbst wenn das gesuchte Wort vorhanden ist. Eine kürzere Zeile mit einem nur bedingt ähnlichem Wort kann dann sogar evtl zu einem besseren Ergebnis führen. Das ist jetzt nur geraten, da ich es jetzt auch nicht genau getestet habe, aber schau dir doch mal deine Zeilen an. Die ersten beiden, die Sommer nicht enthalten, sind recht kurz und könnten daher ähnlicher sein als die beiden anderen längeren Zeilen. Und nochmal zur Verdeutlichung: Treshold = 0 ist am genauesten. Dabei sollten eigentlich nur noch sehr geringfügige Änderungen erkannt werden. Treshold = 50 läßt eigentlich fast alles zu. ;) Ich würde dir empfehlen, einen Wert so umdie 5 zu nehmen. Is jetzt aber auch nur geschätzt. Vielleicht reicht auch schon weniger. Teste es einfach mal aus. |
Alle Zeitangaben in WEZ +1. Es ist jetzt 21:18 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz