Unit Unit8;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Buttons, Math;

type

TForm8 = class(TForm)

Memo1: TMemo;

Memo2: TMemo;

Label1: TLabel;

BitBtn1: TBitBtn;

Label2: TLabel;

procedure BitBtn1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form8: TForm8;

implementation

uses Unit1, Unit5;

{$R *.dfm}

function StringToWords(T: string; List: Tstrings = nil; List2: Tstrings = nil): integer;

var i, z: integer;

s: string;

c: Char;

procedure Check;

begin

if (s > '') and (List < > nil) then

begin

List.Add(S);

z: = z + 1;

end;

s: = '';

end;

begin

i: = 0;

z: = 0;

s: = '';

if t > '' then

begin

while i < = Length(t) + 1 do

begin

c: = t[i];

if (c in ['а'..'я']) or (c in ['А'..'Я']) or (c in ['Ё'..'ё']) or (c in ['А'..'Я']+['-'])

and (c < > ' ') then s: = s + c

else Check;

i: = i + 1;

end;

end;

result: = z;

end;

function nepeBog(const s: string): string;

var i: Integer;

begin

Result: = s;

for i: = 1 to Length(s) do

begin

case s[i] of

'А'..'Я': Result[i]: = Chr(Ord(s[i]) + 32);

'Ё': Result[i]: = 'ё';

end;

end;

end;

procedure TForm8.BitBtn1Click(Sender: TObject);

var i, j, k, Slov_count, g, C, Summ: LongInt;

W: String; //для выделения слов

S: String; //Текст предложения

minWord: String; //для сортировки

min, mini: integer; // для сортировки

WordArr: Array [1..N] of TWord; //Массив слов предложения

Dest: Tstrings; //список слов в тексте

otn: Array [1..N] of real; //относительная частота

H: Array [1..N] of real; // удельная энтропия

SumHi: real; //накопленная эндропия

Lf1: integer; // кол-во слов, 1 раз в тексте

Lfn: integer;

IndIskl: real; // иНдекс исключительности

IndPredsk: real; //индекс предсказуемости

s1: string;

cnt, count1, count2, count3, count4, count5, count6: integer;

abzac: char;

D, dd: string;

flag: boolean;

time: cardinal; //время

MaxE: LongInt; //переменная для нах-ия максимума

A: array[1..N] of integer; //массив для нах-ия максимального эл-та

Distr: real; //индекс дистрибуции

IndIter: real; //индекс итерации

{Поиск слова A в Max словах. Если слово было найдено, то результат ф-ии > -1 }

function FindWord(A: String; Max: Integer): Integer;

var i: Integer;

begin

FindWord: = -1;

for i: =1 to Max do

if (WordArr[i].Value = nepeBog(A)) or (WordArr[i].Value = A) then

begin

FindWord: = i;

exit;

end;

end;

{Нахождение максимального эл-та в массиве частот}

function maxX(A: array of integer): integer;

var i: integer;

maxi: integer;

begin

maxi: =A[0];

for i: =2 to High(A) do

if A[i]> maxi then maxi: =A[i];

maxX: =maxi;

end;

begin

BitBtn1.Enabled: =false;

if Form1.Memo1.Text < > '' then

begin

time: =gettickcount; //засекаем время

Dest: = TstringList.Create;

for i: =0 to Form1.Memo1.Lines.Count-1 do

begin

StringToWords(nepeBog(Form1.Memo1.Lines[i]), Dest); //строку в слова

end;

Summ: =0;

SumHi: =0;

S: =Form1.Memo1.Text;

C: = 1;

for i: =0 to Dest.Count-1 do

begin

W: =Dest.Strings[i];

k: = FindWord(W, Dest.Count);

if k = -1 then //Слово W еще не было встречено

begin

WordArr[C].Value: = W;

WordArr[C].Count: = 1;

Inc(C);

end else Inc(WordArr[k].Count);

end;

Slov_count: =C-1;

Form8.Memo2.Lines[0]: ='Слов в тексте = ' +inttostr(Slov_count);

for i: =1 to C-1 do

begin

//сортировка выбороМ

min: =WordArr[i].Count;

minWord: =WordArr[i].Value;

mini: =i;

for j: =i+1 to C-1 do

if WordArr[j].Count > min then

begin

min: =WordArr[j].Count;

minWord: =WordArr[j].Value;

mini: =j;

end;

WordArr[mini].Count: =WordArr[i].Count;

WordArr[mini].Value: =WordArr[i].Value;

WordArr[i].Count: =min;

WordArr[i].Value: =minWord; //конец сортировки

otn[i]: =(WordArr[i].Count / dest.count); //относительная частота Fi = абс. част / обьем текста

H[i]: =(-1)*otn[i]*Log2(otn[i]); // удельная эндропия Hi=-fi*log2(fi)

SumHi: = SumHi + H[i]; //накопленная эндропия Sum(Hi)

Form8.Memo1.Lines.add(WordArr[i].Value+ ' ' + inttostr(WordArr[i].Count)

+ ' '+ copy(FloatTostr(otn[i]), 1, 5)

+ ' '+ copy(FloatTostr(H[i]), 1, 5));

Summ: =Summ+WordArr[i].Count; //сумма частот

if WordArr[i].Count = 1 then Lf1: =Lf1+1; // слова, которые встретились в тексте только один раз

if WordArr[i].Count > 1 then Lfn: =Lfn+1; //слова, которые встретились в тексте > 1 разa

A[i]: =WordArr[i].Count; //массив частот

end;

Label2.Caption: ='Максимальная частота = ' + inttostr(maxX(A)); //вывод максимальной частоты

IndIskl: = 20* (Lf1 /Dest.Count); // индекс исключительности

IndPredsk: = 100 - (Lf1*100)/ Dest.Count; // индекс предсказуемости (чем меньше, тем привлекательнее текст)

Distr: = sqrt(sqr(maxX(A)) + sqr(Memo1.Lines.Count-2)); //индекс дистрибуциичем (эта величина больше, тем богаче словарь)

IndIter: = Dest.Count / (Memo1.Lines.Count-2); //индекс итерации

Form8.Label1.Caption: ='Cумма частот = ' +inttostr(Summ);

{Знаки препинания и подсчет абзацев}

abzac: =#9;

cnt: =0; count1: =0; count2: =0; count3: =0; count4: =0; count5: =0; count6: =0;

for i: =0 to Form1.Memo1.Lines.Count-1 do

begin

if concat(Form1.Memo1.Lines[i][1], Form1.Memo1.Lines[i][2], Form1.Memo1.Lines[i][3])= concat(' ', ' ', ' ') then

//если первые три символа равны пробелам, то это абзац...

count6: =count6+1;

for j: =1 to length(Form1.Memo1.Lines[i]) do

begin

s1: =copy(Form1.Memo1.Lines[i], j, 1);

if s1=', ' then cnt: =cnt+1;

if s1='.' then count1: =count1+1;

if s1='; ' then count2: =count2+1;

if s1='! ' then count3: =count3+1;

if s1='? ' then count4: =count4+1;

if s1=': ' then count5: =count5+1;

if (s1= abzac) then count6: =count6+1; // если = TAB

end;

end;

Form8.Memo2.Lines[1]: ='Абзацев = ' +inttostr(count6);

Form8.Memo2.Lines[2]: ='================ ';

Form8.Memo2.Lines[3]: ='Точки = ' +inttostr(count1);

Form8.Memo2.Lines[4]: ='Запятые = ' +inttostr(cnt);

Form8.Memo2.Lines[5]: ='Восклиц знак = ' +inttostr(count3);

Form8.Memo2.Lines[6]: ='Вопрос = ' +inttostr(count4);

Form8.Memo2.Lines[7]: ='Двоеточие = ' +inttostr(count5);

Form8.Memo2.Lines[8]: ='Точки с зап = ' +inttostr(count2);

Form8.Memo2.Lines[9]: ='================ ';

Form8.Memo2.Lines[10]: ='Накопленная энтропия = ' + copy(floattostr(SumHi), 1, 5);

Form8.Memo2.Lines[11]: ='Индекс исключительности = ' + copy(floattostr(IndIskl), 1, 5);

Form8.Memo2.Lines[12]: ='Индекс предсказуемости = ' + copy(floattostr(IndPredsk), 1, 5);

Form8.Memo2.Lines[13]: ='Индекс дистрибуции = ' + copy(floattostr(Distr), 1, 5);

Form8.Memo2.Lines[14]: ='Индекс итерации = ' + copy(floattostr(IndIter), 1, 5);

Form8.Memo2.Lines[15]: ='Встреченных > 1 разa = ' +inttostr(Lfn) +' слов';

Form8.Memo2.Lines[16]: ='Встреченных хотя бы раз = ' +inttostr(Form8.Memo1.Lines.Count-2) +' слов';

Form8.Memo2.Lines[17]: ='Встреченных один раз = ' +inttostr(Lf1) +' слов';

Form8.Memo2.Lines[18]: ='================ ';

Form8.Memo2.Lines[19]: ='Числа в тексте: ';

Dest.Free;

{Выделение чисел в тексте}

for k: =0 to Form1.Memo1.Lines.Count-1 do

begin

D: =Form1.Memo1.Lines.Strings[k];

i: =1;

Repeat

while not(D[i] in Digits) and (i< =length(D)) do

inc(i);

dd: ='';

while (D[i] in Digits) and (i< =length(D)) do

begin

dd: =dd+D[i];

inc(i);

end;

if length(dd)< > 0 then

begin

flag: =true;

Form8.Memo2.Lines.Add(' '+ dd);

end;

Until (i> length(D));

end;

if flag=false then Form8.Memo2.Lines[19]: ='Числа в тексте: Не имеется';

time: =gettickcount-time;

Showmessage('Время выполнения анализа= ' + floattostr(time/1000) + ' сек');

Application.Initialize;

Form5: = TForm5.Create(Application);

Form5.Show;

end

else messageDlg('Загрузите текстовый файл', mtInformation, [mbok], 0);

BitBtn1.Caption: ='Анализ произведен';

end;

end.