Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ Исправление ошибок в задаче сортировки и слияния файлов

Автор: Natalia 21.11.2006 3:33

Доброго времени суток! Помогите исправить ошибки в задаче. Певрый раз пишу такое длинное решение. Условие такое: Создать два файла персон, содержащие записи вида "Алла Борисовна Пугачёва". Отсортировать оба файла в обратном порядке по именам. Написать программу слияния содержимого двух файлов в третий, отсортированный в том же порядке.
Общий костяк программы нам дали на уроке (т. е. список названий процедур и функции). По нему составила программу. Но у меня ошибка: переполнение стека. +Я не понимаю перехода от файла к строке (связки) и связи процедур - могла напутать. Помогите разобраться.

Код
type massive=array[1..100] of string;{Первые три процедуры: чтение, запись в файл и сортировка - входят в процедуру слияния-Сборка}
  procedure read_data(fn:string;
                      var mas:massive;
                          n:integer);
   var f:text;
    begin
     assign(f,fn);
     reset(f);
     n:=0;
     while not eof(f) do
      begin
       n:=n+1;
       read(f,mas[n]);
      end;
     close(f);
    end;
  procedure write_data(fn:string;
                       var mas:massive;
                           n:integer);
   var f:text;
       i:integer;
    begin
     assign(f,fn);
     rewrite(f);
      for i:=1 to n do
       writeln(f,mas[i]);
     close(f);
    end;
  procedure sort_data(mas:massive;
                      n:integer);
   var i,j:integer;
       exchange:string;
    begin
     for i:=1 to n-1 do
      for j:=1 to n-i do
       if mas[j]<mas[j+1] then
        begin
         exchange:=mas[j];
         mas[j]:=mas[j+1];
         mas[j+1]:=exchange;
        end;
    end;
  procedure sort(fn:string);{Процедура слияния. Сборка}
   var mas:massive;
       n:integer;
    begin
     read_data(fn,mas,n);
     sort_data(mas,n);
     write_data(fn,mas,n);
    end;
  procedure copy_files(var f,f_res:text); {При слиянии копирует оставшийся файл (первый или второй) в третий}
   var n:integer;
   begin
    n:=0;
    while not eof(f) do
     begin
      n:=n+1;
      readln(f,n);
      writeln(f_res,n);
     end;
   end;
  function test_files(var f1,f2,f_res:text):boolean; {функция проверки: пустой ли файл, если да, то копируется в третий файл с помощью функции}
   begin
    if eof(f1) then
     begin
      copy_files(f2,f_res);
      test_files:=false;
     end
               else
                if eof(f2) then
                 begin
                  copy_files(f1,f_res);
                  test_files:=false;
                 end
                           else test_files:=true;
    end;
  procedure merge_files(var f1,f2,f_res:text); {процедура слияния}
   var a,b:string;
    begin
     readln(f1,a);
     readln(f2,b);
      while not eof(f1) and not eof(f2) do
       begin
        if a>b then
         begin
          writeln(f_res,a);
          read(f1,a);
         end
        else
         begin
          writeln(f_res,b);
          read(f2,b);
         end;
       end;
     test_files(f1,f2,f_res);
  end;
  procedure merge(fn1,fn2,fn_res:string); {Сборка. Процедура слияния файлов}
   var
    f1,f2,f_res:text;
    a,b:string;
     begin
      assign(f1,fn1);
      reset(f1);
      assign(f2,fn2);
      reset(f2);
      assign(f_res,fn_res);
      rewrite(f_res);
       if test_files(f1,f2,f_res) then
        merge_files(f1,f2,f_res);
      close(f1);
      close(f2);
      close(f_res);
     end;
  
  var a,b,c:text; {основная программа}
   begin
    sort('a.txt');
    sort('b.txt');
    merge('a.txt','b.txt','c.txt');
   end.

Автор: volvo 21.11.2006 3:41

Natalia, ты даже не подозреваешь, откуда берется ошибка Stack Overflow smile.gif

Немного математики... Сколько будет 256*100? 25600, правда? А теперь зайди в меню Options -> Memory Sizes в Турбо Паскале, и посмотри, какой установлен размер стека по умолчанию (Stack Size)... Я думаю, как всегда - 16384... А ты пытаешься поместить столько, сколько я насчитал. Что будет?

Вот тут это происходит (ты наверняка просто забыла VAR перед описанием mas):

  procedure sort_data(mas:massive;
n:integer);


(25600 - это размер massive: 100 срок, без указания размера каждая занимает 256 байт)

Автор: Natalia 21.11.2006 4:31

Спасибо за поправку! Честно, немного путаюсь, когда использовать var... Но теперь ошибка в основной программе, где идёт связка с файлом. Я точно не знаю как это сделать + у меня какая-то некорректная работа с файлами у tp7. Поэтому не знаю - у меня ошибка в написании или уже tp7 глючит (в прошлые разы он мне создавал файл не в своей директории, а на другом диске, где стоит FreePascal)

Автор: мисс_граффити 21.11.2006 5:57

почему ты в merge_files пишешь:

read(f1,a);
?
Хочешь считать один символ?

Автор: volvo 21.11.2006 6:23

Natalia, в твоей программе было несколько ошибок (в частности, при чтении из файла нужно было использовать не Read, а ReadLn)... Вот так она работает (с русским языком не тестировал, но английские строки сортирует как положено, обращай внимание на комментарии... Там где перед процедурой стоит OK, я в логике ее работы ничего не менял, если OK не стоит, значит я написал, что изменено, и зачем)

type massive=array[1..100] of string;

procedure read_data(fn:string;
var mas:massive; var n:integer);
var f:text;
begin
assign(f,fn);
reset(f);
n:=0;
while not eof(f) do begin
n:=n+1;
readln(f,mas[n]); { <--- ReadLn }
end;
close(f);
end;

{ OK }
procedure write_data(fn:string;
var mas:massive; n:integer);
var f:text;
i:integer;
begin
assign(f,fn);
rewrite(f);
for i:=1 to n do
writeln(f,mas[i]);
close(f);
end;

{ OK }
procedure sort_data(var mas:massive;
n:integer);
var
i,j:integer;
exchange:string;
begin
for i:=1 to n-1 do
for j:=1 to n-i do
if mas[j]<mas[j+1] then begin
exchange:=mas[j];
mas[j]:=mas[j+1];
mas[j+1]:=exchange;
end;
end;

{ OK }
procedure sort(fn:string);
var
mas:massive;
n:integer;
begin
read_data(fn,mas,n);
sort_data(mas,n);
write_data(fn,mas,n);
end;

procedure copy_files(last: string; var f,f_res:text);
var s: string; { <--- Здесь у тебя зачем-то читались integer-ы }
begin

{ Кроме того, я добавил в параметры еще одну строку, ниже объясню, зачем }
while not eof(f) do begin
readln(f, s);

if (last <> '') and (last > s) then begin
writeln(f_res, last); { Записываем строку last на подходящее место в файл-результат }
last := '';
end;

writeln(f_res, s);
end;

end;

function test_files(a: string; { <--- добавлена строка A как параметр }
var f1,f2,f_res:text):boolean;
begin
{ изначально результат = True, если зашли хоть в один If - будет False }
test_files:=true;

if eof(f1) then begin
copy_files(a, f2,f_res);
test_files:=false;
end;

{ <--- else удален }
if eof(f2) then begin
copy_files(a, f1,f_res);
test_files:=false;
end;

end;

{
Здесь больше всего изменений...
}
procedure merge_files(var f1,f2,f_res:text);
var
a, b:string;
do_it: boolean;

begin
readln(f1,a);
readln(f2,b);

{
Во-первых, цикл не до конца одного из файлов, а пока не изменится эта переменная...
Объясняю, почему: если оставить до конца файла, как было у тебя, то последняя строка
этого файла будет прочитана, но не будет записана в результирующий файл, ибо Eof уже True
}
do_it := true;
while do_it do begin

if a>b then begin
writeln(f_res,a);
writeln(a);
{ Для исправления описанной ранее ситуации делаем так: если Eof сигнализирует о
конце файла, то меняем переменную по которой идет цикл, чтобы на следующей
итерации цикл закончить. Кроме этого, это означает, что ВЕСЬ файл полностью
прочитан и записан в файл-результат, поэтому строку A обнуляем.

Если же Eof не показывает конец файла, то просто читаем из него след. строку }
if eof(f1) then begin
do_it := false;
a := '';
end
else readln(f1,a);
end
else begin
writeln(f_res,b);
writeln(b);

{ то же самое, что описано выше }
if eof(f2) then begin
do_it := false;
b := '';
end
else readln(f2,b);
end;

end;
{
А вот теперь ситуация такая: один из файлов прочитан полностью, а второй...
Либо в нем оставалась одна строка, и она уже прочитана в переменную A или B,
при этом конец файла уже достигнут, и Eof для этого файла вернет True (теперь
ты понимаешь, почему нельзя было оставить то, что было раньше? теряли одну строку);

либо во втором файле осталось еще несколько строк, и конец файла не достигнут.
В любом случае или строка A или строка B (только ОДНА из них !!!) содержат непустую
строку. Вот ее мы и передаем в процедуру test_files, чтобы вставить на нужное место
в результарующем файле
}
if a = '' then
test_files(b,f1,f2,f_res)
else
test_files(a,f1,f2,f_res)
end;

procedure merge(fn1,fn2,fn_res:string);
var
f1,f2,f_res:text;
a,b:string;
begin
assign(f1,fn1); reset(f1);
assign(f2,fn2); reset(f2);

assign(f_res,fn_res); rewrite(f_res);
if test_files('', f1,f2,f_res) then { <--- Здесь пустая строка добавлена, чтобы программа компилировалась }
merge_files(f1,f2,f_res);

close(f_res);
close(f2);
close(f1);
end;

var a,b,c:text;
begin
sort('a.txt');
sort('b.txt');
merge('a.txt','b.txt','c.txt');
end.


Вот и все smile.gif Вроде, ничего не упустил... Будут вопросы или обнаружишь неправильную работу - обращайся, исправим smile.gif

Автор: Natalia 21.11.2006 7:52

Спасибо огромное. smile.gif Разобралась немного. Объяснили как раз те вещи, в которых я плаваю. Сейчас вот переправляю, перепробую все. give_rose.gif
К сожалению у меня снова та же ошибка-не могу её понять: variable identifier expected (указывает на ошибку в файлах в основной программе...)
Утром попробую в институте - может получится)

Автор: lapp 21.11.2006 11:07

Цитата(Natalia @ 21.11.2006 4:52) *

К сожалению у меня снова та же ошибка-не могу её понять: variable identifier expected (указывает на ошибку в файлах в основной программе...)

При этом указывает на строку с присваиванием значения функции? Если так, то это компиляция с опцией совместимости с Delphy. Если ты на FPC, то зайди в Options - Compiler - Syntax и поставь совместимость с TP7 и убери совместимость с Delphy. После этого лучше всего перезапустить FPC.

Автор: volvo 21.11.2006 16:14

Цитата
Если ты на FPC, то зайди в Options - Compiler - Syntax и поставь совместимость с TP7 и убери совместимость с Delphy
Совершенно не обязательно привязываться к настройкам среды...

{$mode TP}

первой строкой программы делает то же самое, только будет работать у всех, а не только там, где это разрешено в IDE...

Кстати, по поводу ошибки:
В TP действительно будет опять ошибка: Переполнение стека... Вот тут:
procedure sort(fn:string);
var
mas:massive; { <--- !!! }
n:integer;
...

(локальные переменные создаются именно в стеке, а я тебе уже показал, почему создание massive в стеке недопустимо)... Выход - перенести описание mas чуть выше:
{ OK }
var
mas:massive; { <--- }

procedure sort(fn:string);
var
n:integer;
begin
read_data(fn,mas,n);
sort_data(mas,n);
write_data(fn,mas,n);
end;
, тогда этот массив (как глобальная переменная) будет размещен уже не в стеке, а в сегменте данных, а его размер ограничен 64К, так что место еще есть smile.gif

Программа с этими исправлениями нормально отрабатывает как в ТР, так и в FPC...

Автор: Natalia 21.11.2006 23:26

Здравствуйте! Спасибо за разъяснения - изменила опции в fpc. Также поменяла директивы, чтоб не путать (tp7 и fpc).
У меня забавная получается ситуация: на ТР программа вроде выполнятеся, но при этом файлы В и А обнуляются, а С остаётся пустым. А если выполнять программу на FPC, то в файлах остаётся по одной строке, а в С записывается только одна строка. Ничего не понимаю! wacko.gif

Автор: volvo 21.11.2006 23:33

blink.gif blink.gif

Цитата
файлы В и А обнуляются
А попробуй-ка сделать вот что... Закомментируй строку
var a,b,c:text;
begin
sort('a.txt');
sort('b.txt');
{ merge('a.txt','b.txt','c.txt'); } { <--- вот так !!! }
end.
и попробуй прогнать программу... Потом зайди в файлы A и B и посмотри, отсортировались ли они, или нет... Что-то непонятное у тебя происходит...

Автор: Natalia 21.11.2006 23:45

A и B обнулились, но с даже не был создан... ( в TP7). А в FPC осталось по строчке в файлах, а С не был создан.

Автор: volvo 22.11.2006 0:02

Присоединяй сюда свою программу в виде файла... Что-то ты намудрила в одной из процедур:
read_data, sort_data или write_data... С теми процедурами, которые привел я такой результат получить невозможно...

Автор: Natalia 22.11.2006 11:01

Вот файл...


Прикрепленные файлы
Прикрепленный файл  MERGE.PAS ( 3.08 килобайт ) Кол-во скачиваний: 250

Автор: volvo 22.11.2006 16:24

Ну, а я что говорил:

procedure read_data(fn:string;
var mas:massive;
n:integer); { <--- Как ты думаешь, N вернется назад, в sort ? }
Мне почему-то кажется, что не вернется... Из-за этого происходит следующее: Ты читаешь все данные, только вот количества прочитанных строк не получаешь. Остается 0 (хотя могла быть и любое другое число - "мусор" - потому, что ЛОКАЛЬНЫЕ переменные компилятором не инициализируются, они создаются в стеке, и то, что там было ДО этого, так и остается. Скорее всего, в случае FPC так и произошло: в N случайно оказалась единица...)...

Дальше - пытаешься сортировать данные. Поскольку N = 0, никакой сортировки не происходит...

Еще дальше - пытаешься перезаписать данные. Опять же N = 0, цикл не выполняется, ничего не записывается, однако файлы A и B уже открыты через ReWrite, а следовательно - очищены...

Добавляй VAR...

Автор: Natalia 22.11.2006 23:32

Добрый вечер! Всё получилось! smile.gif Здорово! Спасибо! Мне почему-то казалось, что var распространяется на все переменные после себя. Мне это хороший урок и тренировка по процедурам.