Buchstabenhäufigkeit

[Luckie]

Ich habe aus der Kanone mal eine Zwille gemacht.

Quick and dirty ohne Klassen ohne Objektlisten:

Ermitteln der Häufigkeit:

Delphi-Quellcode:

unit Unit6;

interface

uses
  SysUtils;

type TCharRecord = record
    FChar: AnsiChar;
    FCharCnt: Cardinal;
end;

var
  CharRecordArray: array [1..26] of TCharRecord;

procedure CntCharOccurrence(Text: AnsiString);

implementation

procedure CntCharOccurrence(Text: AnsiString);
var
  i, j: Integer;
  MyOrdChar: Integer;
  s: AnsiString;
begin
  // Init array
  for j := 1 to 26 do
  begin
    CharRecordArray[j].FChar := Chr(j + 64);
    CharRecordArray[j].FCharCnt := 0;
  end;

  s := AnsiUpperCase(Text);
  for i := 1 to Length(s) do
  begin
    MyOrdChar := Ord(s[i]) - 64; // A = 1, B = 2, ...
    if (MyOrdChar in [1..26]) then
    begin
      CharRecordArray[MyOrdChar].FCharCnt := CharRecordArray[MyOrdChar].FCharCnt + 1;
    end;
  end;
end;

end.

Aufruf:

Delphi-Quellcode:

procedure TForm5.btn1Click(Sender: TObject);
var
  i: Integer;
  s: AnsiString;
begin
  s := '';
  CntCharOccurrence(mmo1.Text);
  for i := 1 to 26 do
  begin
    s := s + Format('%s: %d', [CharRecordArray[i].FChar, CharRecordArray[i].FCharCnt]) + #13#10;
  end;
  ShowMessage(s);
end;

Die Erweiterung um den prozentualen Anteil sollte jetzt kein Problem sein. Den Record um das entsprechende Feld erweitern und nach der Ermittlung der Häufigkeit noch mal in einer Schleife das Array durchgehen und den Prozentualen Anteil ermitteln.

[rokli]

Zwille ist cool!

[rokli]

OT: Wer das wohl noch kennt, geschweige denn bauen kann... und damit schießen!

[Luckie]

Hier die Erweiterung und ein paar Code Verschönerungen:

Delphi-Quellcode:

unit Unit6;

interface

uses
  SysUtils;

type TCharRecord = record
    FChar: AnsiChar;
    FCharCnt: Cardinal;
    FPercentage: Extended;
end;

var
  CharRecordArray: array [1..26] of TCharRecord;

procedure CntCharOccurrence(Text: AnsiString);

implementation

procedure CntCharOccurrence(Text: AnsiString);
var
  i: Integer;
  MyOrdChar: Integer;
  s: AnsiString;
  BaseValue: Integer;
  Percentage: Extended;
begin
  // Init array
  for i := Low(CharRecordArray) to High(CharRecordArray) do
  begin
    CharRecordArray[i].FChar := Chr(i + 64);
    CharRecordArray[i].FCharCnt := 0;
    CharRecordArray[i].FPercentage := 0;
  end;
  // calcualte occurence
  s := AnsiUpperCase(Text);
  s := StringReplace(s, ' ', '', [rfReplaceAll]);
  for i := 1 to Length(s) do
  begin
    MyOrdChar := Ord(s[i]) - 64; // A = 1, B = 2, ...
    if (MyOrdChar in [1..26]) then
    begin
      CharRecordArray[MyOrdChar].FCharCnt := CharRecordArray[MyOrdChar].FCharCnt + 1;
    end;
  end;
  // calculate percentage
  BaseValue := Length(s);
  for i := Low(CharRecordArray) to High(CharRecordArray) do
  begin
    Percentage := CharRecordArray[i].FCharCnt / BaseValue * 100;
    CharRecordArray[i].FPercentage := Percentage;
  end;
end;

end.

Delphi-Quellcode:

procedure TForm5.btn1Click(Sender: TObject);
var
  i: Integer;
  s: AnsiString;
begin
  s := '';
  CntCharOccurrence(mmo1.Text);
  for i := Low(CharRecordArray) to High(CharRecordArray) do
  begin
    s := s + Format('%s: %d' + #9 + '(%2.2f%%)', [CharRecordArray[i].FChar, CharRecordArray[i].FCharCnt, CharRecordArray[i].FPercentage]) + #13#10;
  end;
  ShowMessage(s);
end;

[p80286]

Solange Du Dich auf ANSI-Char beschränkst reicht auch

Delphi-Quellcode:

var
  cntarr:array[0..255] of cardinal;

const
  maxbuff = 4096;
  
var
  edat   : file;
  buffer : array [1..maxbuff] of byte;
  gelesen:integer;
  i      : integer;
begin
  fillchar(cntarr,#0,sizeof(cntarr));
  assignfile(edat,efile);
  reset(edat,1);
  repeat
    blockread(edat,buffer,maxbuff,gelesen);
    for i:=1 to gelesen do
      inc(cntarr[buffer[i]],1);
  until eof(edat) or application.terminated;
  closefile(edat);
end;

Gruß
K-H

[Luckie]

Meine IDE kann noch kein Unicode, deswegen habe ich explizit den Datentyp AnsiString genommen, damit es zu keinen Problemen mit neueren IDE's und Compilern kommt.

[Sherlock]

OT: Ist der TB nicht was feines?


Sherlock
- der wieder stänkert, obwohl das Jahrespensum doch bereits erfüllt schien...mea culpa.

[t.roller]

Ich habe auch eine Lösung:
Es arbeitet mit der Buchstabenhäufigkeit lt. Tabelle in
Buchstabenhäufigkeit in deutschsprachigen Texten

Jeder gefundene Buchstabe wird gelöscht und verkürzt den Text, was nachfolgende Suchen beschleunigt.

Delphi-Quellcode:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Grids, Vcl.ExtDlgs;

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    Memo11: TMemo;
    Memo13: TMemo;
    Button4: TButton;
    OpenTextFileDialog1: TOpenTextFileDialog;
    Button1: TButton;
    procedure Button4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);

  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  nextLetter : Integer;
  LOT : Integer;  //Length(Memo11.text);

implementation

{$R *.dfm}

function CountChars(const subtext, Text: String): Integer;
var Text3 : String;
begin
inc(nextLetter);
Text3:= StringReplace(Text, subtext, '', [rfReplaceAll, rfIgnoreCase]);
Result := Length(Text) - Length(Text3);
Form1.Memo11.text:= Text3;
Form1.StringGrid1.Cells[0,nextLetter]:= subtext;
Form1.StringGrid1.Cells[1,nextLetter]:= INTTOSTR(Result);
Form1.StringGrid1.Cells[2,nextLetter]:= FLOATTOSTR(Result / (LOT/100));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Memo11.Clear; Memo13.Clear;
if OpenTextfileDialog1.Execute then
BEGIN
  Memo11.Lines.LoadFromFile(OpenTextfileDialog1.FileName);
  nextLetter:=0;
  Application.ProcessMessages;
  LOT:= Length(Memo11.text);
END;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
    StringGrid1.Cells[0,0]:= 'Buchstabe';
    StringGrid1.Cells[1,0]:= 'Häufigkeit';
    StringGrid1.Cells[2,0]:= 'Prozent';
    Memo13.Lines.Add('Memo11-Length: '+INTTOSTR(Length(Memo11.text)));
    Memo13.Lines.Add('e: '+INTTOSTR(CountChars('e',Memo11.Text)));
    Memo13.Lines.Add('n:'+INTTOSTR(CountChars('n',Memo11.Text)));
    Memo13.Lines.Add('i: '+INTTOSTR(CountChars('i',Memo11.Text)));
    Memo13.Lines.Add('s: '+INTTOSTR(CountChars('s',Memo11.Text)));
    Memo13.Lines.Add('r: '+INTTOSTR(CountChars('r',Memo11.Text)));
    Memo13.Lines.Add('a: '+INTTOSTR(CountChars('a',Memo11.Text)));
    Memo13.Lines.Add('t: '+INTTOSTR(CountChars('t',Memo11.Text)));
    Memo13.Lines.Add('d: '+INTTOSTR(CountChars('d',Memo11.Text)));
    Memo13.Lines.Add('h: '+INTTOSTR(CountChars('h',Memo11.Text)));
    Memo13.Lines.Add('u: '+INTTOSTR(CountChars('u',Memo11.Text)));
    Memo13.Lines.Add('l: '+INTTOSTR(CountChars('l',Memo11.Text)));
    Memo13.Lines.Add('c: '+INTTOSTR(CountChars('c',Memo11.Text)));
    Memo13.Lines.Add('g: '+INTTOSTR(CountChars('g',Memo11.Text)));
    Memo13.Lines.Add('m: '+INTTOSTR(CountChars('m',Memo11.Text)));
    Memo13.Lines.Add('o: '+INTTOSTR(CountChars('o',Memo11.Text)));
    Memo13.Lines.Add('b: '+INTTOSTR(CountChars('b',Memo11.Text)));
    Memo13.Lines.Add('w: '+INTTOSTR(CountChars('w',Memo11.Text)));
    Memo13.Lines.Add('f: '+INTTOSTR(CountChars('f',Memo11.Text)));
    Memo13.Lines.Add('k: '+INTTOSTR(CountChars('k',Memo11.Text)));
    Memo13.Lines.Add('z: '+INTTOSTR(CountChars('z',Memo11.Text)));
    Memo13.Lines.Add('p: '+INTTOSTR(CountChars('p',Memo11.Text)));
    Memo13.Lines.Add('v: '+INTTOSTR(CountChars('v',Memo11.Text)));
    Memo13.Lines.Add('ß: '+INTTOSTR(CountChars('ß',Memo11.Text)));
    Memo13.Lines.Add('j: '+INTTOSTR(CountChars('j',Memo11.Text)));
    Memo13.Lines.Add('y: '+INTTOSTR(CountChars('y',Memo11.Text)));
    Memo13.Lines.Add('x: '+INTTOSTR(CountChars('x',Memo11.Text)));
    Memo13.Lines.Add('q: '+INTTOSTR(CountChars('q',Memo11.Text)));
    Memo13.Lines.Add('ä: '+INTTOSTR(CountChars('ä',Memo11.Text)));
    Memo13.Lines.Add('ö: '+INTTOSTR(CountChars('ö',Memo11.Text)));
    Memo13.Lines.Add('ü: '+INTTOSTR(CountChars('ü',Memo11.Text)));
    Memo13.Lines.Add('0: '+INTTOSTR(CountChars('0',Memo11.Text)));
    Memo13.Lines.Add('1: '+INTTOSTR(CountChars('1',Memo11.Text)));
    Memo13.Lines.Add('2: '+INTTOSTR(CountChars('2',Memo11.Text)));
    Memo13.Lines.Add('3: '+INTTOSTR(CountChars('3',Memo11.Text)));
    Memo13.Lines.Add('4: '+INTTOSTR(CountChars('4',Memo11.Text)));
    Memo13.Lines.Add('5: '+INTTOSTR(CountChars('5',Memo11.Text)));
    Memo13.Lines.Add('6: '+INTTOSTR(CountChars('6',Memo11.Text)));
    Memo13.Lines.Add('7: '+INTTOSTR(CountChars('7',Memo11.Text)));
    Memo13.Lines.Add('8: '+INTTOSTR(CountChars('8',Memo11.Text)));
    Memo13.Lines.Add('9: '+INTTOSTR(CountChars('9',Memo11.Text)));
    Memo13.Lines.Add('Memo11-Length: '+INTTOSTR(Length(Memo11.text)));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  nextLetter:=0;
  Memo11.Lines.LoadFromFile('F:\schtasks.txt');
  Application.ProcessMessages;
  LOT:= Length(Memo11.text);
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var s: string;
begin
  s := StringGrid1.Cells[ACol, ARow]; 
  StringGrid1.Canvas.FillRect(Rect); 
  DrawText(StringGrid1.Canvas.Handle, PChar(s), Length(s), Rect,
  DT_SINGLELINE or DT_Center or DT_VCENTER); // Text zentrieren
end;

end.

[DeddyH]

Vielleicht denke ich zu simpel, aber würde es für Ansi nicht auch einfach so gehen (die nicht darstellbaren Zeichen habe ich bewusst nicht herausgefiltert)?

Delphi-Quellcode:

type
  TCharCounter = class
  private
    FCounts: array [AnsiChar] of Cardinal;
    FTotal: int64;
  public
    procedure ReadString(const s: AnsiString);
    function GetCount(c: AnsiChar): integer;
    function GetPercentage(c: AnsiChar): single;
    constructor Create;
  end;

constructor TCharCounter.Create;
begin
  FillChar(FCounts, SizeOf(FCounts), 0);
end;

function TCharCounter.GetCount(c: AnsiChar): integer;
begin
  Result := FCounts[c];
end;

function TCharCounter.GetPercentage(c: AnsiChar): single;
begin
  if FTotal = 0 then
    Result := 0
  else
    Result := GetCount(c) / FTotal * 100;
end;

procedure TCharCounter.ReadString(const s: AnsiString);
var
  i: Cardinal;
begin
  FTotal := 0;
  for i := Low(s) to High(s) do
    begin
      FCounts[s[i]] := FCounts[s[i]] + 1;
      inc(FTotal);
    end;
end;

[Jumpy]

Zitat von DeddyH:

FCounts[s[i]] := FCounts[s[i]] + 1;

Das scheint mir aber nicht richtig zu sein, oder?