Исправление ошибок в задаче сортировки и слияния файлов, Ошибки в проге по сортировке файлов и их слиянию. Надо сделать через Опции

[Natalia]

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

Код

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.

Сообщение отредактировано: Natalia - 20.11.2006 23:35

[volvo]

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

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

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

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

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

[Natalia]

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

[мисс_граффити]

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

read(f1,a);

?
Хочешь считать один символ?

[volvo]

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.

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

[Natalia]

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

Сообщение отредактировано: Natalia - 21.11.2006 4:28

[Lapp]

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

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

[volvo]

Если ты на 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К, так что место еще есть

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

[Natalia]

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

Сообщение отредактировано: Natalia - 21.11.2006 19:33

[volvo]

файлы В и А обнуляются

А попробуй-ка сделать вот что... Закомментируй строку

var a,b,c:text;
begin
  sort('a.txt');
  sort('b.txt');
  { merge('a.txt','b.txt','c.txt'); } { <--- вот так !!! }
end.

и попробуй прогнать программу... Потом зайди в файлы A и B и посмотри, отсортировались ли они, или нет... Что-то непонятное у тебя происходит...

[Natalia]

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

Сообщение отредактировано: Natalia - 21.11.2006 19:50

[volvo]

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

[Natalia]

Вот файл...

[volvo]

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

procedure read_data(fn:string;
                var mas:massive;
                n:integer); { <--- Как ты думаешь, N вернется назад, в sort ? }

Мне почему-то кажется, что не вернется... Из-за этого происходит следующее: Ты читаешь все данные, только вот количества прочитанных строк не получаешь. Остается 0 (хотя могла быть и любое другое число - "мусор" - потому, что ЛОКАЛЬНЫЕ переменные компилятором не инициализируются, они создаются в стеке, и то, что там было ДО этого, так и остается. Скорее всего, в случае FPC так и произошло: в N случайно оказалась единица...)...

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

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

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

[Natalia]

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