Worthäufigkeit bestimmen

[Luckie]

Gegeben ist eine Textdatei, Es soll jetzt die Anzahl jedes Wortes ermittelt werden. Hat da jemand eine Idee, wie man da ansetzten könnte? Oder gar schon fertigen Quellcode parat?

So, selbst ist der einsame Programmierer :mrgreen: :

Delphi-Quellcode:

procedure Occurence(sl: TStrings; Text: String; var WordArray: TWordArray);
var
  Loop: Cardinal;
  FoundPos: Cardinal;
  bFound: Boolean;
  s: String;
  Count: Cardinal;
begin
  FoundPos := 0;
  bFound := True;
  Count := 0;
  // Wortliste durchgehen
  for Loop := 0 to sl.Count-1 do
  begin
    while bFound do
    begin
      // Wort aus Wortliste holen
      s := sl.Strings[Loop];
      // Kucken ob in Text vorhanden
      FoundPos := NextPos(s, Text, FoundPos);
      if FoundPos > 0 then  // FoundPos > 0 -> Wort vorhanden, Wort zählen
        Inc(Count)
      else  // nicht mehr vorhanden -> abbrechen
        bFound := False;
    end;
    // WordArray Record füllen
    WordArray[Loop].Word := sl.Strings[Loop];
    WordArray[Loop].Count := Count;
    writeln(WordArray[Loop].Word, WordArray[Loop].Count);
    // Variablen zurücksetzen
    Count := 0;
    bFound := True;
  end;
end;

sl ist die Liste mit Worten deren Häufigkeit ermittelt werden soll, Text der Text in dem die Worthäufigkeit ermittelt werden soll und WordArray sieht so aus:

Delphi-Quellcode:

  TWordRec = record  // zu jedem Wort gehört die Anzahl
    Word: ShortString;
    Count: Cardinal;
  end;
  TWordArray = array of TWordRec;

Muss natürlich vorher mit setlength auf die richtige Länge gesetzt werden.

[Pseudemys Nelsoni]

arg, jetzt war ich die ganze zeit dabei das fertig zu machen und nun hast du das schon :evil:

[Luckie]

Zeig mal was du hast. Eventuell ist das ja besser.

[Pseudemys Nelsoni]

ne besser ist es keinesfalls, aber ich denke ich hätte es irgendwi hinbekommen.

also ich hatte es so(mit nem button und nem memo:

Delphi-Quellcode:

type
  TWordCount = Record
    word: string;
    count: integer;
  end;

...

procedure TForm1.Button1Click(Sender: TObject);
const
  FilePath: string = 'C:\Test.txt';
  sep: char = ' ';
var
  tf: TextFile;
  TempStr, TempWord: string;
  WordCount: Array of TWordCount;
  i: integer;
  IsInArray: boolean;
begin
  AssignFile(tf, FilePath);
  Reset(tf);
  while not EOF(tf) do
  begin
    ReadLn(tf, TempStr);
    TempStr := Trim(TempStr);
    TempStr := TempStr + ' ';
    while pos(sep, TempStr) > 0 do
    begin
      IsInArray := false;
      TempWord := Copy(TempStr, 1, Pos(sep, TempStr)-1);
      Delete(TempStr, 1, Pos(sep, TempStr));
      for i := low(WordCount) to high(WordCount) do
      begin
        if WordCount[i].word = TempWord then
        begin
          IsInArray := true;
          inc(WordCount[i].count);
        end;
      end;
      if not IsInArray then
      SetLength(WordCount, Length(WordCount)+1);
      WordCount[high(WordCount)].word := TempWord;
      WordCount[high(WordCount)].count := 1;
    end;
  end;
  for i := low(WordCount) to high(WordCount) do
    Memo1.Lines.Add('Wort "' + WordCount[i].word + '" ist ' + IntToStr(WordCount[i].count) + ' mal enthalten');
  CloseFile(tf);
  SetLength(WordCount, 0);
  WordCount := nil;
end;

ich glaube das array hab ich am ende falsch freigegeben oder?
Und noch ne Frage, beim ausführen des programms werden mir manche einträge doppelt angezeigt.

z.b wenn das die Textdatei ist:

Zitat:

hallo
hallo2 3
hi
hallo2
3
hi
hi
hi
hi
hi
hi

wird mir beim buttonclick des programms aber nur:

Zitat:

Wort "hallo" ist 1 mal enthalten
Wort "hallo2" ist 2 mal enthalten
Wort "3" ist 2 mal enthalten
Wort "3" ist 1 mal enthalten
Wort "hi" ist 1 mal enthalten

angezeigt. Kannst du mir sagen woran das liegt?

[Luckie]

Also irgendwie steige ich da bei dir nicht so ganz durch. Aber problematisch, was die Performance angeht dürften die copy's und Delete's sein.

[Sharky]

Zitat:

Zitat von Luckie

...sl ist die Liste mit Worten deren Häufigkeit ermittelt werden soll, Text der Text in dem die Worthäufigkeit ermittelt werden soll.....

Hai Luckie,

wenn ich dich richtig verstehe hast Du die Wörter alle in eine Stringliste geladen? Gut.
Aber was ich nicht verstehe ist "...der Text in dem die Worthäufigkeit ermittelt...".

Wenn ich die Wörter der SL zählen sollte würde ich so vorgehen.

• Wörter in SL laden.
• SL sortieren.
• erstes Wort der SL ermitteln.
• Word in DynArry-Record speichern.
• SL weiterdurchlaufen und prüfen ob sich das Word ändert. Wenn Ja Anzahl im Record speichern.
• Mit dem neuen Word weiter machen.
• Das ganze bis ende der SL.

Ich hoffe das ist verständlich? Das Sortieren sollte recht zügig gehen. Und danach ist es nur noch ein durchlaufen der SL mit exact einer vergleichsoperation pro "Zeile".

[M-O-D]

Hallo,

wenn ich mich nicht irre gibts im Delphi 6 Kochbuch ein Rezept dafür, bin mir aber nich sicher... Habe das auch mal probiert, aber den Code verschludert :wall: , sorry.

CU

[Basilikum]

Zitat:

Zitat von Pseudemys Nelsoni

Delphi-Quellcode:

...
      IsInArray := false;
      TempWord := Copy(TempStr, 1, Pos(sep, TempStr)-1);
      Delete(TempStr, 1, Pos(sep, TempStr));
      for i := low(WordCount) to high(WordCount) do
      begin
        if WordCount[i].word = TempWord then
        begin
          IsInArray := true;
          inc(WordCount[i].count);
        end;
      end;
      if not IsInArray then
      SetLength(WordCount, Length(WordCount)+1);
      WordCount[high(WordCount)].word := TempWord;
      WordCount[high(WordCount)].count := 1;
    end;
  end;
...

ich vermute mal, dass hier ein Begin/End vergessen ging:

Delphi-Quellcode:

  if not IsInArray then Begin
    SetLength(WordCount, Length(WordCount)+1);
    WordCount[high(WordCount)].word := TempWord;
    WordCount[high(WordCount)].count := 1;
  end;

[Pseudemys Nelsoni]

hm ich hatte jede zeile der text dtei in der while schleife.

Gibt es alternativen zu delete/copy/paste ?


@Basilikum, ahhh jetzt funzt es :D, wie knnt ich das nur vergessen

[Luckie]

Zitat:

Zitat von Sharky

wenn ich dich richtig verstehe hast Du die Wörter alle in eine Stringliste geladen? Gut.
Aber was ich nicht verstehe ist "...der Text in dem die Worthäufigkeit ermittelt...".

Nimm dir dein Posting zum Beipiel. In der Wortliste stehen die Wörter: "ich", "dich", "hast" und der "Text in dem die worthäufigkeit ermmittelt werden soll" ist dein Posting.

[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;