MyGetAverageWordLengthFromFile

[PeterPanino]

Hallo und schönen Tag!

Inspiriert von dem Wikipedia-Artikel Wortlänge habe ich als kleine Fingerübung eine Funktion geschrieben, um die durchschnittliche Wortlänge einer Textdatei bzw. eines definierbaren Abschnittes einer Textdatei zu ermitteln (wobei ich Wortlänge hier natürlich als Zeichenanzahl definiere):

Delphi-Quellcode:

program GetWordLengthFromFile;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  CodeSiteLogging,
  System.Classes,
  System.SysUtils;

function MyGetAverageWordLengthFromFile(const sFile: TFileName; MaxBytesToRead: Integer): Single;
var
  fs: TFileStream;
  ReadByte: Integer;
  SpacesCount, WordChars: Integer;
  ThisByte: Byte;
  SpaceRead, WordRead: Boolean;
begin
  Result := -1;
  fs := TFileStream.Create(sFile, fmOpenRead or fmShareDenyNone);
  try
    if MaxBytesToRead > fs.Size then
      MaxBytesToRead := fs.Size;

    SpacesCount := 0;
    WordChars := 0;
    SpaceRead := False;
    WordRead := False;
    for ReadByte := 1 to MaxBytesToRead do
    begin
      fs.Read(ThisByte, 1);
      //CodeSite.Send('ThisByte', IntToStr(ThisByte) + ' ' + Chr(ThisByte));
      if ThisByte = 32 then
      begin
        if WordRead then
        begin
          if not SpaceRead then
            Inc(SpacesCount);
          SpaceRead := True;
        end;
        if ReadByte = MaxBytesToRead then
          Dec(SpacesCount);
      end
      else
      begin
        WordRead := True;
        SpaceRead := False;
        Inc(WordChars);
      end;
    end;
    //CodeSite.Send('SpacesCount', SpacesCount);

    Result := WordChars / (SpacesCount + 1);
  finally
    FreeAndNil(fs);
  end;
end;

var
  ThisAverageWordLengthFromFile: Single;

begin
  try
    CodeSite.Send('Start');
    ThisAverageWordLengthFromFile := MyGetAverageWordLengthFromFile('C:\mytext.txt', 1000);
    CodeSite.Send('ThisAverageWordLengthFromFile', ThisAverageWordLengthFromFile);
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

Natürlich kann man die Funktion ganz einfach um eine größere Menge von Wortgrenze-Zeichen erweitern. Wie gesagt, es war ja nur eine Fingerübung.

Bisher hat es bei allen Textdateien sehr gut funktioniert. Findet jemand einen Fehler oder etwas zu verbessern?

[PeterPanino]

Ach ja, wenn die Textdatei nur Leerzeichen enthält, wäre diese Bedingung natürlich nützlich:

Delphi-Quellcode:

if SpacesCount <> -1 then
  Result := WordChars / (SpacesCount + 1);

[PeterPanino]

Auch sollte man

Delphi-Quellcode:

if ThisByte = 32 then

ersetzen durch

Delphi-Quellcode:

if Chr(ThisByte) in [' ', #13, #10] then

!

[Zacherl]

Komm schon .. du bist doch lange genug dabei, um zu wissen, dass man seine Posts 24h lang editieren kann :wink:

Variante für nicht-Dateien:

Delphi-Quellcode:

function AvgWordLength(const Text: String): Single;
var
  I: Integer;
  B: Boolean;
  TotalWordCount,
  TotalWordLength: UInt64;
begin
  Result := 0;
  B := false;
  TotalWordCount := 0;
  TotalWordLength := 0;
  for I := Low(Text) to High(Text) do
  begin
    if (not CharInSet(Text[I], [#00..#32, ',', ';', '.', ':'])) then
    begin
      if (not B) then
      begin
        B := true;
        Inc(TotalWordCount);
      end;
      Inc(TotalWordLength);
    end else
    begin
      B := false;
    end;
  end;
  if (TotalWordCount <> 0) then
  begin
    Result := TotalWordLength / TotalWordCount;
  end;
end;

Inklusive folgender Modifikationen:

1. CharInSet für Unicode Support
2. UInt64 statt Integer für Strings > 2GiB (sicher ist sicher :P)

Hier noch meine Version für Dateien:

Delphi-Quellcode:

function AvgWordLength(const Filename: String; MaxLength: UInt64 = 0): Single;
const
  BUFFERSIZE = 1024 * 16;
var
  FS: TFileStream;
  Buffer: array[0..BUFFERSIZE - 1] of AnsiChar; // Replace with AnsiChar for non-unicode files
  BytesRead,
  I: Integer;
  B: Boolean;
  TotalWordCount,
  TotalWordLength: UInt64;
begin
  Result := 0;
  FS := TFileStream.Create(Filename, fmOpenRead);
  try
    B := false;
    TotalWordCount := 0;
    TotalWordLength := 0;
    while (FS.Position < FS.Size) and ((MaxLength = 0) or (FS.Position < MaxLength)) do
    begin
      BytesRead := FS.Read(Buffer[0], BUFFERSIZE * SizeOf(Buffer[0]));
      for I := 0 to BytesRead div SizeOf(Buffer[0]) - 1 do
      begin
        if (not CharInSet(Buffer[I], [#00..#32, ',', ';', '.', ':'])) then
        begin
          if (not B) then
          begin
            B := true;
            Inc(TotalWordCount);
          end;
          Inc(TotalWordLength);
        end else
        begin
          B := false;
        end;
      end;
    end;
  finally
    FS.Free;
  end;
  if (TotalWordCount <> 0) then
  begin
    Result := TotalWordLength / TotalWordCount;
  end;
end;

Inklusive folgender Modifikationen:

1. Liest Datei Blockweise statt Byteweise aus (stark erhöhte Performance)

[PeterPanino]

Danke für den Code! Heute ist der Tag für Fingerübungen!

Mit deiner Funktion kriege ich aber bei der angehängten Textdatei einen Wert von 1,00, mit meiner Funktion (inkl. Berichtigungen) einen Wert von 9,21!

Hier ist nochmals meine berichtigte Funktion:

Delphi-Quellcode:

function MyGetAverageWordLengthFromFile(const sFile: TFileName; MaxBytesToRead: Integer; const WordBoundaries: string = ' ' + #13 + #10): Single;
var
  fs: TFileStream;
  ReadByte: Integer;
  SpacesCount, WordChars: Integer;
  ThisByte: Byte;
  SpaceRead, WordRead: Boolean;
begin
  Result := -1;
  fs := TFileStream.Create(sFile, fmOpenRead or fmShareDenyNone);
  try
    if MaxBytesToRead > fs.Size then
      MaxBytesToRead := fs.Size;

    SpacesCount := 0;
    WordChars := 0;
    SpaceRead := False;
    WordRead := False;
    for ReadByte := 1 to MaxBytesToRead do
    begin
      fs.Read(ThisByte, 1);
      //CodeSite.Send('ThisByte', IntToStr(ThisByte) + ' ' + Chr(ThisByte));
      //if ThisByte = 32 then
      //if Chr(ThisByte) in WordBoundaries then
      if Pos(Chr(ThisByte), WordBoundaries) > 0 then
      begin
        if WordRead then
        begin
          if not SpaceRead then
            Inc(SpacesCount);
          SpaceRead := True;
        end;
        if ReadByte = MaxBytesToRead then
          Dec(SpacesCount);
      end
      else
      begin
        WordRead := True;
        SpaceRead := False;
        Inc(WordChars);
      end;
    end;
    //CodeSite.Send('SpacesCount', SpacesCount);

    if SpacesCount <> -1 then
      Result := WordChars / (SpacesCount + 1);
  finally
    FreeAndNil(fs);
  end;
end;

[PeterPanino]

Habe es mit dem Taschenrechner nachgeprüft: 9,21 stimmt!
Mit deiner neuesten Version kriege ich jetzt 6,42.

[Zacherl]

Zitat:

Zitat von PeterPanino (Beitrag 1336108)

Habe es mit dem Taschenrechner nachgeprüft: 9,21 stimmt!
Mit deiner neuesten Version kriege ich jetzt 6,42.

Die deutschen Umlaute liegen im Bereich 128..255, wodurch sie bei meinem Filter als Trennzeichen erkannt wurden. Habe diese Range jetzt auch mal zugelassen, allerdings werden jetzt auch Zeichen wie € als korrekter Buchstabe erkannt.

Um das zu 100% korrekt berechnen zu können, müsste man das verwendete Alphabet der Textdatei kennen. Anders wird es immer nur eine Näherung sein.

[PeterPanino]

Zitat:

Zitat von Zacherl (Beitrag 1336110)

Zitat:

Zitat von PeterPanino (Beitrag 1336108)

Habe es mit dem Taschenrechner nachgeprüft: 9,21 stimmt!
Mit deiner neuesten Version kriege ich jetzt 6,42.

Die deutschen Umlaute liegen im Bereich 128..255, wodurch sie bei meinem Filter als Trennzeichen erkannt wurden. Habe diese Range jetzt auch mal zugelassen, allerdings werden jetzt auch Zeichen wie € als korrekter Buchstabe erkannt.

Um das zu 100% korrekt berechnen zu können, müsste man das verwendete Alphabet der Textdatei kennen. Anders wird es immer nur eine Näherung sein.

Stell dir vor, du zahlst 1 Million Euro auf dein Bankkonto ein und nach einer Woche ist leider nur noch die Hälfte davon da. Als du den Banker zur Rechenschaft ziehst, sagt dieser: "Ja, wir haben jetzt eine neue Banking-Software von Zacherl, die hat eine unheimlich gute Performance ..." :wink:

[Zacherl]

Zitat:

Zitat von PeterPanino (Beitrag 1336169)

Stell dir vor, du zahlst 1 Million Euro auf dein Bankkonto ein und nach einer Woche ist leider nur noch die Hälfte davon da. Als du den Banker zur Rechenschaft ziehst, sagt dieser: "Ja, wir haben jetzt eine neue Banking-Software von Zacherl, die hat eine unheimlich gute Performance ..." :wink:

Die Performanceoptimierung ist doch gar nicht das Problem, sondern das verwendete Alphabet. Meine Funktion war auf die standard printable-ASCII-Range (#32..#127) ausgerichtet. Das ist für englische Texte perfekt, aber um bei deinem Vergleich zu bleiben, muss eine Bank in Deutschland natürlich auch darauf achten, dass sie den Betrag in € und nicht in $ überweist.

Sprich: Für deutsche Texte muss man die Umlaute mit ins Alphabet aufnehmen, bei französischen Texten, sollte man alle Buchstaben mit Accent oder Circumflex beachten, und so weiter.

[Amateurprofi]

Für mich ist keine der bisher gezeigten Versionen überzeugend.

In #1 des TE werden alle Zeichen, die keine Alphazeichen sind als Zeichen eines Wortes angesehen.

In #4 werden immerhin Steuerzeichen und ein paar Interpunktionszeichen als nicht zu Worten gehörend angesehen, was auch nicht wirklich Sinn macht.
Nehmen wir den SourceCode des Autors dieses Beitrags als Beispiel, dann sehen wir auf Anhieb ein Dutzend weitere Zeichen, die offensichtlich in Texten vorkommen aber nicht zu Worten gehören.

Auch die Modifikation "2.UInt64 statt Integer für Strings > 2GiB (sicher ist sicher)" ist überflüssig, denn ein String mag > 2GiB sein, aber die Länge (Anzahl Zeichen) liegt innerhalb des Integerbereiches.
Der Autor selbst läuft ja mit

Delphi-Quellcode:

for I := Low(Text) to High(Text) do

durch den Text, wobei I als Integer deklariert ist.
Hier wird deutlich, dass als Integer deklarierte Zähler für Zeichen und Worte unter keinen Umständen "überlaufen" können.

Hier ist mein Vorschlag in dem die in der Windows API deklarierte Funktion "IsCharAlpha" benutzt wird um zu Worten gehörende Zeichen zu erkennen.
Auch das ist sicher nicht optimal, denn je nach Definition des Begriffs "Wort" kann diese Prüfung unvollständig sein.

Delphi-Quellcode:

type
   TFileMetrics=Record
      Chars:Integer;
      AlphaChars:Integer;
      ControlChars:Integer;
      Words:Integer;
      AvgWordLen:Single;
   End;

FUNCTION GetFileMetrics(Dsn:String):TFileMetrics;
var List:TStrings; S:String; P,P1:PChar;
begin
   FillChar(Result,SizeOf(Result),0);
   List:=TStringList.Create;
   try
      try
         List.LoadFromFile(Dsn);
         S:=List.Text;
         if S='' then Exit;
         P:=PChar(S);
         Result.Chars:=Length(S);
         while P^<>#0 do
            if IsCharAlpha(P^) then begin
               P1:=P;
               while IsCharAlpha(P^) do Inc(P);
               Inc(Result.AlphaChars,P-P1);
               Inc(Result.Words);
            end else begin
               if P^<#32 then Inc(Result.ControlChars);
               Inc(P);
            end;
         if Result.Words>0 then Result.AvgWordLen:=Result.AlphaChars/Result.Words;
      except
         on E:Exception do ShowMessage(E.Message);
      end;
   finally
      List.Free;
   end;
end;

PROCEDURE TMain.Test;
begin
   if OpenDialog.Execute then
      with GetFileMetrics(OpenDialog.FileName) do
         ShowMessage('Worte '+IntToStr(Words)+#13+
                     'Avg Länge '+FloatToStr(AvgWordLen)+#13+
                     'Zeichen '+IntToStr(Chars)+#13+'Davon:'+#13+
                     ' - Kontroll Zeichen '+IntToStr(ControlChars)+#13+
                     ' - Alpha Zeichen '+IntToStr(AlphaChars)+#13+
                     ' - Non Alpha Zeichen '+IntToStr(Chars-AlphaChars-ControlChars));
end;