Wörter aus Memo extrahieren

[Gecko]

Hallo,

suche einen Algorithumus, der mir aus einem Memo alle Wörter einzeln herausholt, und das möglichst effizient.

Benutze im Moment diesen hier:

Delphi-Quellcode:

function wort_(s: string; k: integer): string;
var n: integer;
begin
  s := trim(s); //entfernt Leerzeichen, #13 oder andere Steuerzeichen
  n := pos(' ', s);
  if n = 0 then n := pos(#13,s); //Zeilenumbruch
  if n = 0 then Begin
    if k > 1 then result := '' else result := s
  End else Begin //z.B. s='abc def;
    if k > 1 then result := wort_(copy(s, n + 1), k - 1) //rekursiv
    else result := copy(s, 1, n - 1);
  End;
end;

welchen ich per while durchlaufen lasse, bis er nichts mehr aussspuckt.
Allerdings treibt der bei einem gröseren Memo selbst meinen Core 2 Duo in die Knie.

Hoffe ihr könnt mir helfen!

[Bernhard Geyer]

Ruft du wort_ in einer Schleife auf?
Falls ja? Wieso zerlegst du den Text nicht erstmal in ein Stringlist so hast du für einen Text nur einmal die Zerlegung.

Auch mußt du bedenken das Trennzeichen wie :,. keine Wortbestandteile sind und auch Text wie

Zitat:

bla bla bla,bla blba.Bla

also mit fehlenden Leerzeichen nach Trennzeichen erkannt werden müssen.

[Sharky]

Zitat von Gecko:

... suche einen Algorithumus, der mir aus einem Memo alle Wörter einzeln herausholt, und das möglichst effizient.
...

Hai Gecko,

als erstes würde ich definieren was ein Wort ist Dafür würde ich mir eine Liste mit den Trennzeichen erstellen und dann den Text durchlaufen und dabei die Zeichen zwichen zwei Trennzeichen rauskopieren.

Hier einmal ein Ansatz:

Delphi-Quellcode:

procedure GetWords(const s: string; sl: TStrings);
const
  Delimiters: set of Char = [' ', ',', #10, #13, '!', '?'];
var
  start: Integer;
  ende:  Integer;
  ndx:   Integer;
  wort:  string;
begin
  start := 0;
  ende  := 0;
  for ndx := 1 to Length(s) do
  begin
    if s[ndx] in Delimiters then
    begin
      ende := ndx;
    end
    else
    begin
      if (start = 0) then
        start := ndx;
    end;
    if (start > 0) and (ende > 0) then
    begin
      wort := copy(s, start, ende - start);
      sl.Add(wort);
      start := 0;
      ende  := 0;
    end;
  end;
end;


procedure TDemo_Form.Button1Click(Sender: TObject);
begin
  GetWords(Memo1.Text, listbox1.Items);
end;

Du musst natürlich noch einige Sonderfälle berücksichtigen. Zum Beispiel zwei Trennzeichen hintereinander usw.

[Edit]Während ich mir die Flossen wund tippe schreibt Bernhard das in zwei Sätzen

[turboPASCAL]

Noch ne Version ?

Delphi-Quellcode:

Function WordCount(CText: String): Longint;
Var
  Ix: Word;
  Work_Count: Longint;
  anyWord: String;

  // Definiert was Wörter von einander trennt
  Function Seps(As_Arg: Char): Boolean;
  Begin
    Seps := As_Arg In
      [#0..#47, '?', ':', ';', '=', '#', '\', '[', ']', '{', '}', '^'];
  End;

Begin
  Work_Count := 0;
  Ix := 1;
  While Ix <= Length(CText) Do
  Begin
    anyWord := '';

    // den Begin eines Wortes suchen
    While (Ix <= Length(CText)) And (Seps(CText[Ix])) Do
      Inc(Ix);

    If Ix <= Length(CText) Then
    Begin
      // das Ende eines Wortes suchen
      While (Ix <= Length(CText)) And (Not Seps(CText[Ix])) Do
      begin
        Inc(Ix);
        anyWord := anyWord + Form1.Memo1.Text[ix-1];
      end;

     Inc(Work_Count);

     Form1.ListBox1.Items.Add(anyWord);

     // Windows nachrichten zw. Windows und eigener App. verarbeiten lassen
     Application.ProcessMessages;
    End;
  End;
  Result := Work_Count;
End;

Abgelitten von Wörter in einem String zählen

[marabu]

Hallo,

die Funktion SysUtils.WrapText() ist manchmal auch ganz hilfreich - einfach MaxCol auf 1 setzen.

Grüße vom marabu

[Gecko]

. (falscher post)

[chaoslion]

Hey,
hier wäre noch ne Möglichkeit:

Delphi-Quellcode:

procedure parseWords( const str: string; var tokens: TStringList );
var
  i: integer;
  buf: string;
  j: integer;
begin
  i := 1;
  
  while( i <= length(str) )do
  begin

    if( (ord(str[i]) <= 32) )then
    begin
      inc(i);
      continue;
    end
    else if( str[i] in ['A'..'z'] )then
    begin
      j := i;
      while( (i<= length(str)) and ((str[i] in ['A'..'z']) or (str[i] in ['0'..'9']) or (str[i] = '_') ) )do
        inc(i);
      buf := copy(str,j,i-j);
      tokens.Add(buf);
    end
    else
     inc(i);
  end;

end;