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?

[negaH]

DAWG zu klein und Datei zu groß. Man könnte das DWAG anpassen damit es mit wesentlich größeren Datenmengen auskommt ist aber nicht ganz so einfach. Primär habe ich es entwickelt als hoch effiziente Suchmachine in einer Wortdatenbank mit ca. 200.000 deutschen und 250.000 englischen Wörtern. Dabei werden aber nur sehr wenige Wortseparatoren benutzt, also die Sonderzeichen die ein Wort von einem anderen separieren. Das wären nur die Sonderzeichen ' ', #13, #10 und TabSpace. Alle anderen Sonderzeichen werden als Wortbuchstaben interpretiert. Du müsstest also den Source für die EXE leicht abändern:

Delphi-Quellcode:

  // Zeichenmapping definieren, Großbuchstaben werden in Kleinbuchstaben umgewandelt
  // TDawg.LoadWordsFromFile() führt auch somit eine Konvertierung und Filterung durch
    for I := Low(C) to High(C) do C[I] := I;
    CharLowerBuff(@C, SizeOf(C));

    FDawg := TDawg.Create;
    FDawg.SetMapping(C, [#0,#10,#13,';',' ',',']);
    FDawg.LoadWordsFromFile(OD1.FileName);

da muss das Zeichenmapping -> FDawg.SetMapping() verändert werden. Wenn nur Buchstaben und Ziffern gültige Wörter sein sollen dann so abändern

Delphi-Quellcode:

var
  Chars: TDawgMapping;
  Separators: TDawgCharSet;
  I: TDawgChar;
....
begin
....
  // Zeichenmapping definieren, Großbuchstaben werden in Kleinbuchstaben umgewandelt
  // TDawg.LoadWordsFromFile() führt auch somit eine Konvertierung und Filterung durch
    for I := Low(TDawgChar) to High(TDawgChar) do 
      Chars[I] := I;
    CharLowerBuff(@Chars, SizeOf(Chars));

  // erzeuge das Set der Wort-Separatoren-Zeichen
  // alle Zeichen die nicht Buchstaben/Ziffern sind sind Separatoren    
    Separators := [];
    for I := Low(TDawgChar) to High(TDawgChar) do 
      if not (I in ['a'..'z', 'A'..'Z', '0'..'9']) then
        Separators := Separators + [I];

    FDawg := TDawg.Create;
    FDawg.SetMapping(Chars, Separators);
    FDawg.LoadWordsFromFile(OD1.FileName);
....
end;

Nun werden Wörter nur dann akzeptiert wenn sie aus Buchstaben oder Ziffern bestehen, alle anderen Zeichen trennen die einzelnen Wörter voneinander. Obige Änderung könnte dein Problem lösen, aber auch nur dann wenn viele Sonderzeichen im Text vorkommen. Das DAWG kann soviele absolut unterschiedliche Wörter speichern so das die Buchstabenanzahl all dieser Wörter nicht 2^21 überschreitet, also 2^21 Nodes a 4 Byte. Ein im Text mehrfach vorkommendes Wort wird natürlich nur einmalig im DAWG gespeichert. Sogar bei Wörter mit gleichem Anfang wird dieser Anfang nur einmalig gespeichert.

Wenn also immer noch der Fehler kommt dann muß man das DAWG so umbauen das es mehr Nodes aufnehmen kann. Der Aufwand lohnt aber nicht wenn mit deiner Methode die 122Mb in 3 Sekunden gelesen werden kann, das ist schon ein sehr guter Wert.

Gruß Hagen

[negaH]

Ich habe mal eine 144Mb Textdatei erzeugt, das DAWG benötigt 1.6 Sekunden um daraus alle Wörter sortiert zu extrahieren. Deine Methode ist also mit 3 Sekunden wirklich schon sehr schnell. Könntest du hier deinen Source posten ?

Gruß Hagen

[kng]

Naja ich verwende einfach die TRegExprEx Komponente von dieser Seite mit dem Ausdruck "[a-zA-Z0-9]+".

Das Laden der Datei war in den 3 Sekunden allerdings nicht miteinbezogen, trotzdem schnell genug für meine Zwecke.

[omata]

Zitat:

Zitat von kng

Hab die ganze Prozedur jetzt mit einem regulären Ausdruck abgedeckt.

:thumb:

Reguläre Ausdrücke sind einfach genial und dieses Beispiel zeigt mal wieder das sie eben nicht langsamer sind.

[negaH]

Zitat:

...dieses Beispiel zeigt mal wieder das sie eben nicht langsamer sind.

Vorsicht, bisher wurde kein aussagekräftiger Vergleich angestellt. Zb. möchte ich per RegEx eine große Textdatei durchsuchen und die Anzahl unterschiedlicher Wörter im Text ermitteln. Ich wette einen Kasten Bier das das DAWG als komplett anderer Algorithmus diese Aufgabe bei weitem besser erledigt als RegEx. Es hängt also von den Rahmenbedingungen ab und später beim Vergleich der verschiedenen Verfahren untereinander müssen dann auch identische Testbedingungen herrschen. Meine Angabe von oben mit 144Mb Textdatei in 1.6 Sekunden enthält das Laden und Sortieren der gefundenen Wörter aus der Textdatei. Zusätzlich wird auch noch on the fly die so erzeugte Wortdatenbank im Speicher komprimiert.

Gruß Hagen