Помощь - Поиск - Пользователи - Календарь
Полная версия: Частотная характеристика триграмм
Форум «Всё о Паскале» > Pascal, Object Pascal > Практика продвинутого программирования на Pascal
Margo
Задание такое: частотная характеристика триграмм в русских текстах.
В турбопаскале все работало, в FPC выдает error 2, если не указывать расширение входного файла, и 216, если указывать.
В чем дело, понять не могу wacko.gif
Вот текст программы:
program analyzer;
const ALPH_SIZE = 31;
const CAPS_ALPH : string[ALPH_SIZE] = 'АБВГДЕЖЗИКЛМНОПРСТУФХЦЧШЩЫЬЭЮЯ ';
const SMALL_ALPH : string[ALPH_SIZE-1] = 'абвгдежзимлнопрстуфхцчшщыьэюя';
type TFreqArray = array [1..ALPH_SIZE, 1..ALPH_SIZE, 1..ALPH_SIZE] of word;
TPtrArray = ^TFreqArray;
var outfile : text;
name : string;
name1: string;
freq1: TPtrArray;
total1: longint;
a : longint;
i : longint;
j : longint;
textSize : longint;
function CountFreq(filename: string; freq: TPtrArray; var total: longint) :boolean;
var inpFile : text;
n, n0, n1 : byte;
c : char;
begin
new (freq1);
assign (inpFile, filename);
{$I-}
reset (inpFile);
{$I+}
{
if IOResult <> 0 then begin
writeln ('File', filename, 'Такого файла нет');
CountFreq := false;
exit;
end;
}
total := 0;
n0 := 0; n1 := 0;
while not eof(inpFile) do begin
read (inpFile, c);
n:= pos(c, SMALL_ALPH) + pos(c, CAPS_ALPH);
if n*n0*n1 <> 0 then begin
inc(freq^[n, n0, n1]);
inc(total);
end;
n0 := n;
n1 := n0;
end;
close (inpFile);
CountFreq := true;
end;
procedure WriteFreq (filename: string; freq: TPtrArray; var total: longint);
var outFile : text;
i, j, k, t : byte;
ni, nj, nk : byte;
p : real;
H : real;
R : real;
begin
assign (outfile, filename);
rewrite (outfile);
writeln (outFile, 'Result Analysis (filename: ', name1,')');
h:=0;
for i:=1 to ALPH_SIZE do
for j:=1 to ALPH_SIZE do
for k:=1 to ALPH_SIZE do
p:=freq^[i,j,k]/total;
begin
if (p>0) then h:=h-ln(p)/ln(2)*p;
{writeln (outFile, CAPS_ALPH[i], CAPS_ALPH[j], CAPS_ALPH[k],' : ', freq^[i,j,k]:5,' : ', p:6:4);}
end;

for t := 1 to 20 do begin
ni := 1; nj := 1; nk := 1;
for i:=1 to ALPH_SIZE do
for j:=1 to ALPH_SIZE do
for k:=1 to ALPH_SIZE do
if freq^[i,j,k]>freq^[ni, nj, nk]
then begin
ni:=i; nj:=j; nk:=k;
end;
p:=freq^[ni,nj,nk]/total;
writeln (outFile, CAPS_ALPH[ni], CAPS_ALPH[nj], CAPS_ALPH[nk],' : ', freq^[ni,nj,nk]:5,' : ', p:6:4);
freq^[ni,nj,nk] := 0;
end;
H:=H/3;
writeln (outFile, 'Энтропия: ', H:0:4);
R:= 1-H*ln(2)/ln(ALPH_SIZE);
writeln (outFile, 'Избыточность:', R*100:0:2, '%');
close (outFile);
end;
begin
new(freq1);
write ('Введите имя исходного файла:');
readln (name1);
name:= name1;
if (pos('.', name)>0)
then delete (name, pos('.', name), 255);
if not CountFreq (name1, @freq1, total1) then exit;
WriteFreq (name+ '.fr1', @freq1, total1);
dispose(freq1);
end.
IUnknown
Цитата
В турбопаскале все работало
Может, оно не вылетало, но не вылетать и работать - это разные вещи. Имеется в виду, конечно, "работать правильно". В том виде, в котором программа приведена здесь, она не является рабочей. Потому что:

Цитата
for i:=1 to ALPH_SIZE do
for j:=1 to ALPH_SIZE do
for k:=1 to ALPH_SIZE do
p:=freq^[i,j,k]/total; // <--- Вот это всё, что делается в цикле...
begin // <--- Это - уже после цикла.
if (p>0) then h:=h-ln(p)/ln(2)*p;
{writeln (outFile, CAPS_ALPH[i], CAPS_ALPH[j], CAPS_ALPH[k],' : ', freq^[i,j,k]:5,' : ', p:6:4);}
end;


Второе: если название файла не содержит расширения, то он будет открыт и обработан. Если же содержит - то вот тут:
Цитата

write ('Введите имя исходного файла:');
readln (name1);
name:= name1;
if (pos('.', name)>0)
then delete (name, pos('.', name), 255); // <--- Вот именно в этом месте
все, что после первой точки из имени файла будет убрано. И как ты его собралась открывать, если файл называется test.txt, а внутрь функции CountFreq передается просто 'test'? Это ж гарантированная ошибка при открытии файла!!! Хотя бы передавала полное имя, и потом убирала расширение (кстати, для того, чтобы сменить расширение, в FPC есть функция SysUtils.ChangeFileExt, не надо делать весь тот ужас с поиском точки, удалением содержимого строки, и добавлением к ней нового расширения).
Margo
Поняла...Спасибо большое!
То есть мне нужно вот здесь
 for i:=1 to ALPH_SIZE do
for j:=1 to ALPH_SIZE do
for k:=1 to ALPH_SIZE do
p:=freq^[i,j,k]/total;
begin
if (p>0) then h:=h-ln(p)/ln(2)*p;
{writeln (outFile, CAPS_ALPH[i], CAPS_ALPH[j], CAPS_ALPH[k],' : ', freq^[i,j,k]:5,' : ', p:6:4);}
end;

сделать все в одном цикле?
Ну а тут
write ('Введите имя исходного файла:');
readln (name1);
name:= name1;
if (pos('.', name)>0)
then delete (name, pos('.', name), 255);
не знаю, как сама не догадалась, правда не очень понимаю, как сделать это с функцией
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.