Обработка блоков тестков разделенных набором символов.
Поиск слов (словосочетаний) в этих блоках. Подсчет частоты встречаемости.
Работа с лексемами и т.д.
Жду Ваших предложений

procedure create_vocabulary (file1,file2:string);
var
f,g: text;
begin
assign (g,file2);
assign (f,file1);
g:=f;
end.
program RFP;
const
source='data.txt';
file2='filt2.txt';
vocab='vocabul.txt';
procedure file_preprocess(file1_,file2_:string);
var
f,res:text;
symb:char;
begin {0}
assign (f,file1_);
reset(f);
assign (res,file2_);
rewrite (res);
while not eof (f) do
begin {1}
while not eoln do
begin {2}
read (f,symb);
if symb<>' ' then write (res, symb)
else write (res,CHR(13));
end; {2}
end; {1}
close (f);
close (res);
end; {0}
{===========================================================}
{ Выделение всех уникальных элементов в массиве }
{ (создание частотного словаря текста) }
{===========================================================}
procedure create_vocabulary (file1_:string);
var
bufer: array[1..10000] of string;
stroka: string;
f,voc: text;
schetchik,i,j,k:integer;
begin
file_preprocess(file1_,file2);
i:=0;
assign (f,file2);
reset(f);
assign (voc,vocab);
rewrite(voc);
while not eof (f) do
begin {1}
inc(i);
readln (f,bufer[i]);
end; {1}
j:=1;
while j<=i do
begin {2}
if bufer[j]<>'' then
begin {3}
stroka:=bufer[j];
for k:=1 to i do
begin {4}
if stroka=bufer[k] then
begin
bufer[k]:='';
inc(schetchik);
end;
write (voc,stroka);write (voc,' -+- ');
write (voc,schetchik); writeln(voc);
end; {4}
end; {3}
end; {2}
erase (f);
close (voc);
end;
begin
create_vocabulary (source);
end.
while not eof (f) doна
begin {1}
while not seekeof (f) do
begin {1}
while j<=i do begin {2}без отмеченной строчки будет выполняться очень долго, так что увеличение j все-таки добавь...
if bufer[j]<>'' then begin {3}
stroka:=bufer[j];
for k:=1 to i do begin {4}
if stroka=bufer[k] then begin
bufer[k]:='';
inc(schetchik);
end;
write (voc,stroka);write (voc,' -+- ');
write (voc,schetchik); writeln(voc);
end; {4}
end; {3}
inc(j); { <--- !!! Увеличиваем J !!! --- }
end; {2}
program RFP;
const
source='data.txt';
file2='filt2.txt';
vocab='vocabul.txt';
var
symb1:char;
procedure file_preprocess(file1_,file2_:string);
var
sourf,res:text;
symb:char;
begin {0}
assign (sourf,file1_);
reset(sourf);
assign (res,file2_);
rewrite (res);
while not eof (sourf) do
begin {1}
while not eoln (sourf) do
begin {2}
read (sourf,symb);
if (ORD(symb)>=65) and (ORD(symb)<=90) OR
(ORD(symb)>=97) and (ORD(symb)<=122) then
begin {33}
if (ORD(symb)>=65) and (ORD(symb)<=90) then
write (res, chr(ord(symb)+32))
else write (res, symb);
end {33}
else
begin {11}
if (ORD(symb)=38) then write (res, symb)
else
begin {22}
writeln (res);
{writeln (res, symb);}
end; {22}
end; {11}
end; {2}
readln (sourf);
writeln(res);
end; {1}
close (sourf);
close (res);
end; {0}
{===========================================================}
{ Выделение всех уникальных элементов в массиве }
{ (создание частотного словаря текста) }
{===========================================================}
procedure create_vocabulary (file1_:string);
var
bufer: array[1..7000] of string [30]; {Здесь у меня ПРОБЛЕМА.
ЧТО можно сделать чтобы можно было поставить, например, 100 000???}
str1,stroka: string;
f,voc: text;
schetchik,i,j,k:integer;
begin
i:=0;
assign (f,file1_);
reset(f);
while not eof (f) do
begin {1}
readln (f,stroka);
if stroka<>'' then
begin
inc(i);
bufer[i]:=stroka
end;
end; {1}
close (f);
assign (voc,vocab);
rewrite(voc);
j:=1;
while j<=i do
begin {2}
if bufer[j]<>'' then
begin {3}
stroka:=bufer[j];
schetchik:=0;
for k:=1 to i do
begin {4}
if stroka=bufer[k] then
begin
bufer[k]:='';
inc(schetchik);
end;
end; {4}
str(schetchik,str1);
stroka:=concat(stroka,' ............... ',str1);
writeln (voc,stroka);
end; {3}
inc(j);
end; {2}
close (voc);
end;
begin
file_preprocess(source,file2);
create_vocabulary (file2);
end.
const
max_count = 100000;
var
bufer: array[1..max_count] of string [30];
max_count = 100000;, но на всякий случай счетчики i, j, k я сделал типа LongInt ...