Частотная характеристика триграмм Опции

[Margo]

Задание такое: частотная характеристика триграмм в русских текстах.
В турбопаскале все работало, в FPC выдает error 2, если не указывать расширение входного файла, и 216, если указывать.
В чем дело, понять не могу
Вот текст программы:

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.

Сообщение отредактировано: Margo - 17.05.2012 23:40

[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);

не знаю, как сама не догадалась, правда не очень понимаю, как сделать это с функцией

Сообщение отредактировано: Margo - 20.05.2012 14:45