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.