Worthäufigkeit bestimmen

[Christian Seehase]

Moin Luckie,

ich würde einen anderen Ansatz nehmen:

Es wird der Originaltext übergeben, und eine Stringliste für die Ergebniswortliste. Der Rückgabewert entspricht der Anzahl der Worte im Text.
Die zulässigen Zeichen, die ein Wort ausmachen liesse sich natürlich auch noch als Parameter angeben:

Delphi-Quellcode:

function CountWords(const AsText : string;const AslResult : TStringList) : integer;

const
  _acsValidInWord = ['a'..'z','A'..'Z','ä','ö','ü','Ä','Ö','Ü'];

var
  iStart : integer;
  iStop  : integer;
  iLen   : integer;
  sWord  : string;
  iIndex : integer;

begin
  Result := 0;
  AslResult.Clear;
  AslResult.Sorted     := true;
  AslResult.Duplicates := dupIgnore;
  iStart := 1;
  iLen   := length(AsText);
  // Definierten Zustand schaffen:
  // iStart zeigt garantiert auf einen Wortanfang, oder Text enthält keine Worte
  while (iStart <= iLen) and not (AsText[iStart] in _acsValidInWord) do inc(iStart);

  // Resttext verarbeiten
  while iStart <= iLen do begin
    iStop := iStart;
    while (iStop <= iLen) and (AsText[iStop] in _acsValidInWord) do inc(iStop);
    sWord  := copy(AsText,iStart,iStop-iStart);
    inc(Result);
    iIndex := AslResult.IndexOf(sWord);
    if iIndex = -1 then begin
      AslResult.AddObject(sWord,TObject(1));
    end else begin
      AslResult.Objects[iIndex] := TObject(integer(AslResult.Objects[iIndex])+1);
    end;
    while (iStop <= iLen) and not (AsText[iStop] in _acsValidInWord) do inc(iStop);
    iStart := iStop;
  end;
end;

[Luckie]

Wegen Blödheit vor dem Code geklöscht. :wall:

[Luckie]

Hier noch mal die korrekte prozedur, in der ursprünglichen war ein Denkfehler:

Delphi-Quellcode:

{------------------------------------------------------------------------------}
{  Worthäufigkeit ermitteln                                                    }
{------------------------------------------------------------------------------}

procedure Occurence(sl: TStrings; Text: string; var WordArray: TWordArray);
var
  OuterLoop, InnerLoop: Cardinal;
  TextWordList: TStringDynArray;
  Count: Cardinal;
begin
  TextWordList := Explode(' ', Text);
  Count := 1;
  // Wortliste durchgehen
  for OuterLoop := 0 to sl.Count - 1 do
  begin
    for InnerLoop := 0 to Length(TextWordList) - 1 do
    begin
      if sl.Strings[OuterLoop] = TextWordList[InnerLoop] then
        inc(Count);
    end;
    WordArray[OuterLoop].Word := sl.Strings[OuterLoop];
    WordArray[OuterLoop].Count := Count;
    Count := 1;
    if bCancel = 1 then
      Break;
  end;
end;