Написал прогу для анализа текста на частотность слов. это очень полезная вещь, для изучения иностранных языков.
В программе два окна- Мемо и Листбокс. В мемо виден текст, а в Листбоксе выводятся слова и колличество повторений в тексте.
Текст должен быть в кодировке UTF-8 если текст использует национальные шрифты. Для английского текста можно в обычной кодировке.
В Листбоксе обязательно установить поле sorted в true !!!!!!!!!!!!!!!!!!!
Код:
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Label1: TLabel;
Label2: TLabel;
ListBox1: TListBox;
Memo1: TMemo;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
MyStr: TStringList;
st1: String;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
begin
MyStr:=TStringList.Create; // создаём объект TStringList
if OpenDialog1.Execute then // загружаем файл в кодировке UTF-8
MyStr.LoadFromFile(OpenDialog1.FileName);
st1:= MyStr.Text;//помещаем в строковую переменную
Memo1.Lines.Text:= st1; //Помещаем текст в мемо ( для визуального наблюдения)
st1:=StringReplace(st1,'.',' ',[rfReplaceAll]); // заменяем разделители на пробелы
st1:=StringReplace(st1,',',' ',[rfReplaceAll]);
st1:=StringReplace(st1,'!',' ',[rfReplaceAll]);
st1:=StringReplace(st1,'?',' ',[rfReplaceAll]);
st1:=StringReplace(st1,'(',' ',[rfReplaceAll]);
st1:=StringReplace(st1,')',' ',[rfReplaceAll]);
st1:=StringReplace(st1,'[',' ',[rfReplaceAll]);
st1:=StringReplace(st1,']',' ',[rfReplaceAll]);
st1:=StringReplace(st1,'{',' ',[rfReplaceAll]);
st1:=StringReplace(st1,'}',' ',[rfReplaceAll]);
st1:=StringReplace(st1,'-',' ',[rfReplaceAll]);
st1:=StringReplace(st1,'_',' ',[rfReplaceAll]);
//убираем лишние пробелы внутри текста
while(pos(' ',st1)<>0) do st1:=StringReplace(st1,' ',' ',[rfreplaceall]);
//загружаем в листбокс
ListBox1.Items.Text:= stringReplace(st1, ' ', #13#10, [rfReplaceAll]);;
for i := Listbox1.Items.Count - 1 downto 0 do // удаляем в листбоксе пустые строки
if Listbox1.Items[i]='' then
Listbox1.Items.Delete(i);
end;
procedure TForm1.Button2Click(Sender: TObject);
var
i, con1: Integer;
begin
con1:= 1; // счётчик вхождения слова
for i := Listbox1.Items.Count-1 downto 1 do
begin
if Listbox1.Items[i-1]= Listbox1.Items[i] then
begin
con1:=con1+1;
Listbox1.Items.Delete(i);
end
else
begin
Listbox1.Items[i]:= (Listbox1.Items[i]+ '=' +IntToStr(con1));
con1:= 1;
end;
end;
//так как цикл на одну итерацию меньше, то последнее
//поле заполняется после выхода из цикла.
Listbox1.Items[0]:= (Listbox1.Items[0]+ '=' +IntToStr(con1));
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.Lines.Text:='';
end;
end.