Слияние двух отсортированных по возрастанию файлов.

На семинаре возникли проблемы с решением этой задачи без использования сложных условий. Предлагаю такой вариант. Вроде бы вышло довольно прозрачно, поэтому без комментариев.

  1. program MergeFile;
  2.  
  3. procedure MergeFile(var f1,f2,outp:Text);
  4. var x,y:integer;
  5.     flag1,flag2:boolean;
  6. begin
  7.    flag1:=not eof(f1);
  8.    flag2:=not eof(f2);
  9.    if (flag1) then read(f1,x);
  10.    if (flag2) then read(f2,y);
  11.    while (flag1 and flag2) do begin
  12.      if (x<y) then begin                
  13.        write(outp,x,' ');
  14.        flag1:=not eof(f1);
  15.        if (flag1) then read(f1,x);
  16.      end
  17.      else begin
  18.        write(outp,y,' ');
  19.        flag2:=not eof(f2);
  20.        if (flag2) then read(f2,y);
  21.      end;
  22.    end;
  23.    if (flag1) then write(outp,x,' ');
  24.    if (flag2) then write(outp,y,' ');
  25.   while (not eof(f1)) do begin  
  26.     read(f1,x);
  27.     write(outp,x,' ');
  28.   end;
  29.   while (not eof(f2)) do begin
  30.     read(f2,y);
  31.     write(outp,y,' ');
  32.   end;
  33. end;
  34.  
  35. var f1,f2,f3:Text;
  36.      s:string;
  37. begin
  38.  write('Name of first file: ');
  39.  readln(s);
  40.  assign(f1,s);
  41.  write('Name of second file: ');
  42.  readln(s);
  43.  assign(f2,s);
  44.  write('Name of output file: ');
  45.  readln(s);
  46.  assign(f3,s);
  47.  reset(f1);
  48.  reset(f2);
  49.  rewrite(f3);
  50.  MergeSort(f1,f2,f3);
  51.  close(f1);
  52.  close(f2);
  53.  close(f3);
  54.  readln;
  55. end.

Внешняя сортировка файла.

  1. program File_Sort;
  2.  
  3. procedure FileSort(s1,s2:string);
  4. const lim = 500;
  5. type Ar= array [1..lim] of integer;
  6.      T = file of Integer;
  7.      pT = ^T;
  8. var inp,outp:T;
  9.  
  10. procedure CopyToMas (var inp:T; var mas:Ar; var i:word);
  11. begin
  12.   i:=1;
  13.   while (not eof(inp)) and (i<=lim) do begin
  14.     read(inp,mas[i]);
  15.     inc(i);
  16.   end;
  17.   dec(i);
  18. end;
  19.  
  20. procedure Sort(var a:Ar; n:word); // Шейкерная сортировка.
  21. var
  22.   flag:boolean;
  23.   i,j,l,r:word;
  24.   w:integer;
  25. begin
  26.   flag:=true;
  27.   l:=1; r:=n;
  28.   while (l<r) and flag do begin
  29.     flag:=false;
  30.     for i:=l to r-1 do begin
  31.       if (a[i]>a[i+1]) then begin
  32.         w:=a[i]; a[i]:=a[i+1]; a[i+1]:=w;
  33.         r:=i;
  34.       end;
  35.     end;
  36.     for j:=r downto (l+1)  do begin
  37.       if (a[j]<a[j-1]) then begin
  38.         w:=a[j]; a[j]:=a[j-1]; a[j-1]:=w;
  39.         flag:=true;
  40.         l:=j;
  41.       end;
  42.     end;
  43.   end;
  44. end;
  45.  
  46. procedure Merge(var f,outp:T; var mas:Ar; i:word);
  47. var j:word;
  48.     x:integer;
  49.     flag:boolean;
  50. begin
  51.    reset(f);
  52.    rewrite(outp);
  53.    j:=1;
  54.    flag:=not eof(f);
  55.    if (flag) then read(f,x);
  56.    while (flag and (j<=i)) do begin
  57.      if (x<mas[j]) then begin
  58.        write(outp,x);
  59.        flag:=not eof(f);
  60.        if (flag) then read(f,x);
  61.      end
  62.      else begin
  63.        write(outp,mas[j]);
  64.        inc(j);
  65.      end;
  66.    end;
  67.    if (flag) then write(outp,x);
  68.   while (not eof(f)) do begin
  69.     read(f,x);
  70.     write(outp,x);
  71.   end;
  72.   while (j<=i) do begin
  73.     write(outp,mas[j]);
  74.     inc(j);
  75.   end;
  76.   close(f);
  77.   close(outp);
  78. end;
  79.  
  80. var mas:Ar;
  81.     n:word;
  82.     f:T;
  83. begin
  84.  assign(inp,s1);     // Привязка исходного файла.
  85.  assign(outp,s2);  // Привязка выходного файла.
  86.  reset(inp);           // Открываем для чтения исходный файл.
  87.  assign(f,'tmp');    //---
  88.  rewrite(f);           // Создаем пустой временный файл.
  89.  close(f);              //---
  90.  while (not eof(inp)) do begin
  91.   CopyToMas(inp,mas,n); // Заполняем массив из исходного файла и сортируем. При этом
  92.   Sort(mas,n);                  // запоминаем индекс n последнего введенного элемента.
  93.   Merge(f,outp,mas, n);   // Производим слияние массива (до инд. n) и врем. файла.
  94.   erase(f); //Уничтожаем временный файл.
  95.   rename(outp,'tmp'); // ---
  96.   assign(f,'tmp');         // "Меняем" файлы
  97.   rename(f,s2);           //  местами
  98.   assign(outp,'tmp');   // ---
  99.  end;
  100.  close(inp);  //Закрываем исх. файл.
  101. end;
  102.  
  103.  
  104. var s1,s2:string;
  105.  
  106. begin
  107.   write('Enter name of input file: ');
  108.   readln(s1);
  109.   write('Enter name of output file: ');
  110.   readln(s2);
  111.   FileSort(s1,s2);
  112. end.

Вспомогательная программа для

Вспомогательная программа для просмотра результата:

  1. program ShowFInTxt;
  2. var f1: file of integer;
  3.     f2:Text;
  4.     x:integer;
  5.     s:string;
  6. begin
  7.  write('Enter name of file: ');
  8.  readln(s);
  9.  assign(f1,s);
  10.  s:=s+'.txt';
  11.  assign(f2,s);
  12.  reset(f1);
  13.  rewrite(f2);
  14.  while not eof(f1) do begin
  15.   read(f1,x);
  16.   writeln(f2,x);
  17.  end;
  18.  close(f1);
  19.  close(f2);
  20. end.

Поправочки

  1. if (flag1) then read(f1,x);
  2.    if (flag2) then read(f2,y);
  3. while (flag1 and flag2) do begin
  4.      if (x<y) then begin                
  5.        write(outp,x,' ');
  6.        flag1:=not eof(f1);
  7.        if (flag1) then read(f1,x);
  8.      end
  9.      else begin
  10.        write(outp,y,' ');
  11.        flag2:=not eof(f2);
  12.        if (flag2) then read(f2,y);
  13.      end;
  14.    end;
  15.    if (flag1) then write(outp,x,' ');
  16.    if (flag2) then write(outp,y,' ');

считаю, что можно исправить на более компактно

  1. while (not eof (f1)) and (not eof (f2)) do begin
  2.      read (f1,x);
  3.      read (f2,y);
  4.      if (x<y) then write(outp,x,' ',y,' ');
  5.      else  write(outp,y,' 'x,' ');
  6.    end;

Морока с флагами по моему совсем не нужна, только усложняет, приходится пересчитывать их значения перед каждой проверкой.
Записывать в файл придется и х и у, причем если x>y то сначала х потом у, а если y>=x, то наоборот, почему бы не сделать эту запись в одном операторе write. Таким образом становится не нужным и специальные 2 условия, которые ты сделал после цикла. Пока не кончился ни 1 файл все будет выводиться. А потом выполнятся строчки 25-32 для дописывания остатка большего файла, где кстати ты не использовал флаг, зачем было вводить его ранее?:)
Если ошибаюсь - поправьте меня

Кирилл и Антон

По поводу комментария Кирилла. Дело в том, что мы не можем обойтись однократным сравнением элементов для того, чтобы определить, предшествует ли элемент из одного файла всем последующим элементам из другого файла. Твой вариант основного цикла охватывает лишь единственный случай числовой последовательности в файле, когда i-тые элементы обоих файлов отличаются на какую-то фиксированную величину.
Приведу пример. Думаю, можно сделать это неформально, не расписывая каждый шаг алгоритма в таблице.
Пусть даны две упорядоченных по возрастанию последовательности: 1 2 3 4 и 7 8 9 10. По твоей версии мы берем первые два числа из каждой: 1 и 7, 1 меньше 7, поэтому в результирующую последовательность записываем 1 7. Далее сравниваем 2 и 8, 2 меньше 8, поэтому получаем 1 7 2 8. По исчерпанию обоих последовательностей мы получим последовательность 1 7 2 8 3 9 4 10, которая не является упорядоченной по возрастанию.
Что касается решения Антона, то оно корректное, и как я ни пытался упростить его, мне не удалось сделать этого без значительного увеличения кода. Более результативным оказалось только вырожденное решение, в котором дублируется весь главный цикл с отказом от условных операторов, а после выхода из него заново начинается проверка оставшихся элементов, один из которых будет последним в каком-то из файлов. Этот вариант в лучшем случае (если последовательности можно объединить сцеплением) дает выигрыш лишь на (n + m - 1) операций, а в худшем случае не дает совсем ничего.
Вопрос улучшений решения Антона по-прежнему остается открытым. Хотя, как мне кажется, здесь уже мало что можно улучшить.

Мой вариант решения

Представляю на обзор свое решение общей задачи. Оно более элементарно и модульно по сравнению с решением Антона, но проигрывает ему в быстродействии. Весь принцип решения отличается лишь тем, что процедурная обработка файлов осуществлена не в терминах абстрактного файла, а в терминах конкретных файловых имен.
Не считаю нужным отправлять решение по одной процедуре, так как не вижу в задаче какой-то ключевой подпрограммы. Здесь важна и логика самого метода слияния, и конкретно алгоритм сортировки файла слиянием.
Кстати, спасибо Александру Смольнякову за то, что он напомнил мне о методе задания пользовательских типов.
Собственно, код:

  1. program SortFileMerge;
  2.  
  3. const
  4.   Lim = 1000; // длина сортировочного массива
  5.   Rnd = 1000; // граница отрезка псевдослучайных чисел
  6.  
  7. type // создание пользовательских типов для удобства работы
  8.   MyType = integer; // тип записей файла
  9.   NumOfEl = longword; // тип количества записей в файле
  10.   IndArr = 1..Lim; // тип индексов элементов сортировочного массива
  11.   IntFile = file of MyType;
  12.   IntArr = array[1..Lim] of MyType;
  13.  
  14. var
  15.   f: IntFile;
  16.   i, n: NumOfEl;
  17.   x: MyType;
  18.   s: array[1..2] of string; // имена вводного и выводного файлов
  19.  
  20. procedure ArraySortShaker(var A: IntArr; n: IndArr); // шейкерная сортировка массива
  21. var i, l, r, p: IndArr;
  22.     t: MyType;
  23.     flag: boolean;
  24. begin
  25.   p:= n;
  26.   l:= 1;
  27.   r:= n;
  28.   flag := true;
  29.   while flag and (r > l) do begin
  30.     flag := false;
  31.     for i:= r downto l + 1 do begin
  32.       if A[i] < A[i - 1] then begin
  33.         t := A[i];
  34.         A[i] := A[i - 1];
  35.         A[i-1] := t;
  36.         flag := true;
  37.         p := i
  38.       end
  39.     end;
  40.     l := p;
  41.     for i:= l to r - 1 do begin
  42.       if A[i] > A[i + 1] then begin
  43.         t := A[i];
  44.         A[i] := A[i + 1];
  45.         A[i + 1] := t;
  46.         flag := true;
  47.         p := i
  48.       end
  49.     end;
  50.     r := p
  51.   end
  52. end;
  53.  
  54. procedure ArrToFile(s: string; A: IntArr; n: IndArr); // создание файла из массива
  55. var f: IntFile;
  56.     i: IndArr;
  57. begin
  58.   Assign(f, s);
  59.   Rewrite(f);
  60.   for i := 1 to n do begin
  61.     write(f, A[i])
  62.   end;
  63.   Close(f)
  64. end;
  65.  
  66. procedure MergeTwoFiles(s, s1, s2: string); // слияние двух файлов
  67. var f, f1, f2: IntFile;
  68.     x, y: MyType;
  69. begin
  70.   Assign(f, s);
  71.   Assign(f1, s1);
  72.   Assign(f2, s2);
  73.   Reset(f);
  74.   Reset(f1);
  75.   Rewrite(f2);
  76.   while not eof(f) and not eof(f1) do begin
  77.     read(f, x);
  78.     read(f1, y);
  79.     if x > y then begin
  80.       write(f2, y);
  81.       Seek(f, FilePos(f) - 1) // возвращаемся на 1 позицию назад в источнике неиспользованной переменной
  82.     end
  83.     else begin
  84.       write(f2, x);
  85.       Seek(f1, FilePos(f1) - 1) // возвращаемся на 1 позицию назад в источнике неиспользованной переменной
  86.     end
  87.   end;
  88.   if eof(f) then begin
  89.     while not eof(f1) do begin
  90.       read(f1, x);
  91.       write(f2, x)
  92.     end
  93.   end
  94.   else begin
  95.     while not eof(f) do begin
  96.       read(f, x);
  97.       write(f2, x)
  98.     end
  99.   end;
  100.   Close(f);
  101.   Close(f1);
  102.   Close(f2)
  103. end;
  104.  
  105. procedure FileSortMerge(s, s1: string); // сортировка файла слиянием
  106. var A: IntArr;
  107.     f, f1: IntFile;
  108.     i: IndArr;
  109. begin
  110.   Assign(f1, 'tmp1.dat');
  111.   Rewrite(f1); // создание пустого файла tmp1.dat
  112.   Close(f1);
  113.   Assign(f, s);
  114.   Reset(f);
  115.   while not eof(f) do begin // пока не исчерпали сортируемый файл
  116.     i := 1;
  117.     while (i <= Lim) and not eof(f) do begin // считываем очередной фрагмент файла
  118.       read(f, x);
  119.       A[i] := x;
  120.       inc(i)
  121.     end;
  122.     dec(i); // получаем количество использованных элементов в массиве
  123.     ArraySortShaker(A, i); // сортируем созданный массив
  124.     ArrToFile('tmp2.dat', A, i); // создаем файл из отсортированного массива
  125.     MergeTwoFiles('tmp1.dat', 'tmp2.dat', 'tmp3.dat'); // сливаем два файла в третий
  126.     Assign(f1, 'tmp1.dat');
  127.     Erase(f1); // удаляем первый временный файл
  128.     Assign(f1, 'tmp2.dat');
  129.     Erase(f1); // удаляем второй временный файл
  130.     Assign(f1, 'tmp3.dat');
  131.     Rename(f1, 'tmp1.dat') // переименовываем третий файл для следующего шага цикла
  132.   end;
  133.   Rename(f1, s1); // переименовываем полученный файл в конечный
  134.   Close(f)
  135. end;
  136.  
  137. procedure FileMenu; // процедура для работы с файлами
  138. var f: IntFile;
  139.     i: byte;
  140. begin
  141.   writeln('Operations with the file:');
  142.   writeln('1) Display the input file');
  143.   writeln('2) Display the output file');
  144.   writeln('3) Exit');
  145.   write('Enter the number of operation: ');
  146.   readln(i);
  147.   case i of
  148.     1, 2:
  149.     begin
  150.       write('The contents of the file: ');
  151.       Assign(f, s[i]);
  152.       Reset(f);
  153.       while not eof(f) do begin
  154.         read(f, x);
  155.         write(x, ' ')
  156.       end;
  157.       Close(f);
  158.       writeln;
  159.       FileMenu
  160.     end;
  161.     3: // пустой оператор
  162.     else begin
  163.       writeln('Error! Incorrect instruction!');
  164.       FileMenu
  165.     end;
  166.   end;
  167. end;
  168.  
  169. begin // тело главной программы
  170.   write('Enter the name of input file: ');
  171.   readln(s[1]);
  172.   write('Enter the name of output file: ');
  173.   readln(s[2]);
  174.   write('Enter the number of elements: ');
  175.   readln(n);
  176.   Assign(f, s[1]);
  177.   Rewrite(f);
  178.   writeln('Generating of elements...');
  179.   randomize; // запуск генератора псевдослучайных чисел
  180.   for i := 1 to n do begin
  181.     x := random(Rnd * 2 + 1) - Rnd; // генерируем элемент в отрезке [-Rnd, Rnd]
  182.     write(f, x)
  183.   end;
  184.   Close(f);
  185.   writeln('Sorting of file...');
  186.   FileSortMerge(s[1], s[2]); // вызов главной процедуры
  187.   FileMenu // вызов меню для работы с файлами
  188. end.

По поводу варианта Кирилла.

По поводу варианта Кирилла. Мне кажется его код самый компактный, единственное условие надо усложнить.

  1. if (x≤y) then

Правда Кирилл у тебя не предусмотрен еще возврат “коретки”, посмотри у Данила он написал в своем коде.