Wörter aus Text extrahieren beschleunigen

[kng]

Hallo Leute,

Ich habe mir folgende Prozedur geschrieben, welche alle Wörter in einem bestimmten Charset aus einem Text extrahiert.

Delphi-Quellcode:

type
  SetOfChar = Set of Char;

procedure ExtractWords(const AText: string;
                       AMinLength, AMaxLength: Integer;
                       AAllowedChars: SetOfChar;
                       AWords: TStrings);
var
  i, iLength: Integer;
  sWord     : string;
begin
   i := 0;
   while i < Length(AText) do
   begin
     Inc(i);
     if AText[i] in AAllowedChars then
     begin
      sWord := '';
      repeat
        sWord := sWord + AText[i];
        Inc(i);
      until not (AText[i] in AAllowedChars);
      iLength := Length(sWord);
      if ((AMinLength = 0) or (iLength >= AMinLength)) and
         ((AMaxLength = 0) or (iLength <= AMaxLength)) then
        AWords.Add(sWord);
     end;
   end;
end;

Funktioniert, aber ist bei großen Texten etwas langsam, hat jemand eine Idee, wie man das ganze bescheunigen bzw. optimieren kann?

[Mackhack]

Vlt. durch Pointer und/oder Vermeidung von ueberfluessigen wiederholungen bestimmter Funktionen das ganze zu beschleunigen!

[omata]

Schalte mal bitte deine Bereichsprüfung ein, da knallt und ballert es ja nur so von Fehlermeldungen...

Hier mal eine Korrektur...

Delphi-Quellcode:

procedure ExtractWords(const AText: string;
                       AMinLength, AMaxLength: Integer;
                       AAllowedChars: SetOfChar;
                       AWords: TStrings);
var
  i, iLength, TextLength: Integer;
  sWord     : string;
begin
  AWords.BeginUpdate;
  try
    AWords.Clear;
    i := 0;
    TextLength := Length(AText);
    while i < TextLength do
    begin
      Inc(i);
      if AText[i] in AAllowedChars then
      begin
        sWord := '';
        repeat
          sWord := sWord + AText[i];
          Inc(i);
        until    (i > TextLength)
              or not (AText[i] in AAllowedChars);
        iLength := Length(sWord);
        if     ((AMinLength = 0) or (iLength >= AMinLength))
           and ((AMaxLength = 0) or (iLength <= AMaxLength)) then
        begin
          AWords.Append(sWord);
        end;
      end;
    end;
  finally
    AWords.EndUpdate;
  end;
end;

Ich habe gerade eine 100MB große Datei mit deiner Routine bearbeitet, das hat 7 Sekunden gedauert. Ist das wirklich zu langsam? Wie groß sind den deine Dateien?

Meine Testumgebung...

Delphi-Quellcode:

var Datei:file of char;
    Data:string;
    Start:TDateTime;
    Words:TStringList;
begin
  Words:=TStringList.Create;
  try
    try
      assignfile(Datei, 'test.txt');
      reset(Datei);
      setlength(Data, filesize(Datei));
      BlockRead(Datei, Data[1], filesize(Datei));
    finally
      closefile(Datei);
    end;
    Start:=Now;
    ExtractWords(Data, 0, 0, ['<', 'd', 'i', 'v', '>'], Words);
    ShowMessage(TimeToStr(Now - Start) + ' = Wörter: ' + inttostr(Words.Count));
  finally
    Words.free;
  end;
end;

[alzaimar]

Erfahrungsgemäß ist die größte Spaß/Performancegrenze (meistens) sowas wie

Delphi-Quellcode:

MyString := MyString + Character

Ersetze das durch:

Delphi-Quellcode:

SetLength (MyString, AMaxLength+1);
iLength := 0;
While Text[i] in aAllowedChars Do begin
  inc (iLength);
  MyString[iLength] := Text[i];
  inc(i);
  If (iLength > aMaxLength) and (aMaxLength > 0) Then Break;
  End;

Weiterhin solltest Du deine optimalen Min/Max-Längenangaben anpassen: So benötigst Du immer vier Abfragen, statt 2.
Statt

Delphi-Quellcode:

if ((AMinLength = 0) or (iLength >= AMinLength)) and ((AMaxLength = 0) or (iLength <= AMaxLength)) then
  aWords.Append(aWord);

Am Anfang:

Delphi-Quellcode:

If aMaxLength=0 Then aMaxLength = MaxInt;

Und dann

Delphi-Quellcode:

If (iLength>=aMinLength) And (iLength<=aMaxLength) Then aWords.Append(aWord);

Auf 'aMinLength=0' musst Du nicht prüfen.

Dann vereinfacht sich die innere Schleife zu:

Delphi-Quellcode:

SetLength (MyString, AMaxLength+1);
iLen := 0;
While (Text[i] in aAllowedChars) And (iLen<=aMaxLength) Do begin
  inc (iLen);
  MyString[iLen] := Text[i];
  inc(i);
End;

So ist dann mein Vorschlag:

Delphi-Quellcode:

procedure ExtractWords(const AText: string;  AMinLength, AMaxLength: Integer;
   AAllowedChars: SetOfChar;  AWords: TStrings);
var
  i, iLength, TextLength: Integer;
  sWord : string;

begin
  If aMaxLength=0 Then aMaxLength = MaxInt;

  AWords.BeginUpdate;
  try
    AWords.Clear;
    i := 0;
    TextLength := Length(AText);
    while i < TextLength do begin
      Inc(i);
      if Text[i] in aAllowedChars then begin
        SetLength (MyString, AMaxLength+1);
        iLength := 0;
        repeat 
          inc (iLength);
          MyString[iLength] := Text[i];
          inc(i);
        until (iLength > aMaxLength) or (not (Text[i] in aAllowedChars))
        if (iLength >= aMinLength) And (iLength <= aMaxLength) Then 
          aWords.Append(aWord);
      end;
    end;
  finally
    AWords.EndUpdate;
  end;
end;

Getippt und nicht getestet. Imho gehts noch schneller durch Verwendung von PChar und dynamischen Arrays statt einer TStringList.

[kng]

Hab die ganze Prozedur jetzt mit einem regulären Ausdruck abgedeckt.
Trotzdem Danke an alle. :zwinker:

[alzaimar]

Und, wie schnell ist das nun?

[negaH]

Lade dir von hier http://www.michael-puff.de/Developer...agen_Reddmann/ die Datei Dawg.zip.

Ein DAWG -> Directed Acyclic Word Graph ist eine Wörterdatenbank. Normalerweise benutzt man sie eher um Suchen in großen Wörterdatenbanken sehr effizient durchzuführen zb. Rechtschreibprüfungen, Scrabble Engine, Kreuzworträtsel Solver/Generatoren. Man kann damit auch einen langen Text in dessen Wörter zerlegen. Das geht enorm effizient und ich habe dieses DAWG auch schon für sogenannte Mail-Scanner die in parallel mehrere Text nach Schlagwörtern durchsuchen eingesetzt.

Benutzen kannst du dieses DAWG so:

Delphi-Quellcode:

procedure Test(const Text: String; Strings: TStrings);

  procedure DoPrint(Strings: TStrings; Word: PChar; WordLength: Integer): Boolean; register;
  begin
    Strings.Add(Word);
    Result := False;
  end;

var
  Dawg: TDawg;
begin
  Dawg := TDawg.Create;
  try
    Dawg.Insert(PChar(Text), Length(Text)); // erzeuge Wörterliste aus String als Text

// Alternativen
    Dawg.LoadWordsFromFile('MyFile.txt');   // erzeuge Wörterliste aus Text Datei
    Dawg.LoadWordsFromStream(MyStream);     // erzeuge Wörterliste aus TStream
    Dawg.InsertSrings(MyStringList);        // erzeuge Wörterliste aus TStrings

// Anzeige der gefundenen Wörter, alphabethisch, in einem TString Object
    Dwag.Enum(@DoPrint, Strings);
  finally
    Dawg.Free;
  end;
end;

Dieses DAWG ist enorm schnell, probier es aus. Eine Textdatei mit 200.000 verschiedenen deutschen Wörtern die 2.54Mb groß ist wird als DWAG, also in alle Wörter zerlegt, in 127ms auf einem P4 1.5Ghz 512Mb Prozessor geladen. Das DWAG enthält danach diese 200.000 Wörter und benötigt 811Kb im Speicher.

Gruß Hagen

[kng]

Zitat:

Zitat von alzaimar

Und, wie schnell ist das nun?

Bei einem Test mit einer 122 MB großen Datei und den Zeichen a-z, A-Z, 0-9 dauerten omata's und deine Prozedur ~ 8 Sekunden.
Mit einem Regulären Ausdruck ~ 3 Sekunden.

[negaH]

Kannst du irgendwie mal diese 122Mb Datei zur Verfügung stellen, oder aus dem DAWG.zip die mitgeliferte EXE an deiner Datei ausprobieren -> Button "DAWG importieren".

Gruß Hagen

[kng]

Zitat:

Zitat von negaH

Kannst du irgendwie mal diese 122Mb Datei zur Verfügung stellen, oder aus dem DAWG.zip die mitgeliferte EXE an deiner Datei ausprobieren -> Button "DAWG importieren".

Gruß Hagen

Wenn ich das mache, bekomme ich bloß die Meldung "The dawg run out of space.".

//Diese Meldung bekomme ich auch bei Dateien ab 10 MB, wie kann das sein?