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

[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 - 21.11.2006 3:35

[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.

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