Einzelnen Beitrag anzeigen

PeterPanino

Registriert seit: 4. Sep 2004
1.451 Beiträge
 
Delphi 10.4 Sydney
 
#1

MyGetAverageWordLengthFromFile

  Alt 20. Apr 2016, 11:59
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?
  Mit Zitat antworten Zitat