AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Programmieren allgemein Delphi MyGetAverageWordLengthFromFile

MyGetAverageWordLengthFromFile

Ein Thema von PeterPanino · begonnen am 20. Apr 2016 · letzter Beitrag vom 22. Apr 2016
Antwort Antwort
Seite 1 von 2  1 2   
PeterPanino

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

MyGetAverageWordLengthFromFile

  Alt 20. Apr 2016, 12: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
PeterPanino

Registriert seit: 4. Sep 2004
1.442 Beiträge
 
Delphi 10.4 Sydney
 
#2

AW: MyGetAverageWordLengthFromFile

  Alt 20. Apr 2016, 13:22
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);
  Mit Zitat antworten Zitat
PeterPanino

Registriert seit: 4. Sep 2004
1.442 Beiträge
 
Delphi 10.4 Sydney
 
#3

AW: MyGetAverageWordLengthFromFile

  Alt 20. Apr 2016, 13:59
Auch sollte man if ThisByte = 32 then ersetzen durch if Chr(ThisByte) in [' ', #13, #10] then !
  Mit Zitat antworten Zitat
Benutzerbild von Zacherl
Zacherl

Registriert seit: 3. Sep 2004
4.629 Beiträge
 
Delphi 10.2 Tokyo Starter
 
#4

AW: MyGetAverageWordLengthFromFile

  Alt 20. Apr 2016, 14:28
Komm schon .. du bist doch lange genug dabei, um zu wissen, dass man seine Posts 24h lang editieren kann

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 )

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)
Projekte:
- GitHub (Profil, zyantific)
- zYan Disassembler Engine ( Zydis Online, Zydis GitHub)

Geändert von Zacherl (20. Apr 2016 um 15:47 Uhr)
  Mit Zitat antworten Zitat
PeterPanino

Registriert seit: 4. Sep 2004
1.442 Beiträge
 
Delphi 10.4 Sydney
 
#5

AW: MyGetAverageWordLengthFromFile

  Alt 20. Apr 2016, 15:08
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;
Angehängte Dateien
Dateityp: zip test3.zip (294 Bytes, 1x aufgerufen)

Geändert von PeterPanino (20. Apr 2016 um 15:10 Uhr)
  Mit Zitat antworten Zitat
PeterPanino

Registriert seit: 4. Sep 2004
1.442 Beiträge
 
Delphi 10.4 Sydney
 
#6

AW: MyGetAverageWordLengthFromFile

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

Geändert von PeterPanino (20. Apr 2016 um 15:26 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von Zacherl
Zacherl

Registriert seit: 3. Sep 2004
4.629 Beiträge
 
Delphi 10.2 Tokyo Starter
 
#7

AW: MyGetAverageWordLengthFromFile

  Alt 20. Apr 2016, 15:45
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.
Projekte:
- GitHub (Profil, zyantific)
- zYan Disassembler Engine ( Zydis Online, Zydis GitHub)
  Mit Zitat antworten Zitat
PeterPanino

Registriert seit: 4. Sep 2004
1.442 Beiträge
 
Delphi 10.4 Sydney
 
#8

AW: MyGetAverageWordLengthFromFile

  Alt 21. Apr 2016, 08:20
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 ..."
  Mit Zitat antworten Zitat
Benutzerbild von Zacherl
Zacherl

Registriert seit: 3. Sep 2004
4.629 Beiträge
 
Delphi 10.2 Tokyo Starter
 
#9

AW: MyGetAverageWordLengthFromFile

  Alt 21. Apr 2016, 11:11
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 ..."
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.
Projekte:
- GitHub (Profil, zyantific)
- zYan Disassembler Engine ( Zydis Online, Zydis GitHub)
  Mit Zitat antworten Zitat
Amateurprofi

Registriert seit: 17. Nov 2005
Ort: Hamburg
1.039 Beiträge
 
Delphi XE2 Professional
 
#10

AW: MyGetAverageWordLengthFromFile

  Alt 21. Apr 2016, 15:36
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 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;
Gruß, Klaus
Die Titanic wurde von Profis gebaut,
die Arche Noah von einem Amateur.
... Und dieser Beitrag vom Amateurprofi....
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 1 von 2  1 2   

Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 10:41 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz