Всем доброго времени суток. Задали лабу реализовать алгоритм многофазной сортировки слиянием в файлах на Делфи или Паскале. Вот суть

Многоканальную (m-канальную) сортировку слиянием можно выполнить с помо- 
помощью лишь т + 1 файлов (в отличие от описанной выше 2/п-файловой стратегии). 
При этом выполняется ряд проходов с объединением серий из т файлов в более 
длинные серии в (т + 1)-м файле. Вот последовательные шаги такой процедуры. 
1. В течение одного прохода, когда серии от каждого из т файлов объединяются в 
серии (т + 1)-го файла, нет нужды использовать все серии от каждого из т 
входных файлов. Когда какой-либо из файлов становится выходным, он запол- 
заполняется сериями определенной длины, причем количество этих серий равно ми- 
минимальному количеству серий, находящихся в сливаемых файлах. 
2. В результате каждого прохода получаются файлы разной длины. Поскольку ка- 
каждый из файлов, загруженных сериями в результате предшествующих т прохо- 
проходов, вносит свой вклад в серии текущего прохода, длина всех серий на опреде- 
определенном проходе представляет собой сумму длин серий, созданных за предшест- 
предшествующие т проходов. (Если выполнено менее т проходов, можно считать, что 
гипотетические проходы, выполненные до первого прохода, создавали серии 
длины 1.).
Подобный процесс сортировки слиянием называется многофазной сортировкой. 

Кто знает помогите пожалуйста



Заранее благодарен

Я не программист, но что-то получилось.

unit sort;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus, ExtCtrls, Grids, ComCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    Edit1: TEdit;
    GroupBox1: TGroupBox;
    Button1: TButton;
    Button2: TButton;
    StringGrid1: TStringGrid;
    StringGrid2: TStringGrid;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label6: TLabel;
    T1: TStringGrid;
    T2: TStringGrid;
    T3: TStringGrid;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    StringGrid4: TStringGrid;
    Label10: TLabel;
    Edit2: TEdit;
    Label5: TLabel;
    Label11: TLabel;
    Button3: TButton;

    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    
  private
    { Private declarations }
  public
    { Public declarations }
  end;
const
    max = 10000;    // максимальное значение элементов массива
var
  Form1: TForm1;
  elm : integer;  // число элементов массива
  i,j,k,contr : integer;


implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject); // создать и заполнить массив произвольными элементами

var
    i   : integer;  // параметр цикла

begin
  elm:=StrToInt(Edit1.Text); // кол-во элементов массива
  Randomize; // инициализация генератора псевдослучайных чисел
if  (elm < 1) then
  begin
    ShowMessage('Oшибка. Массив не создан!');
    elm:=0;
  end
else begin
  StringGrid1.colcount:=elm; // ввод размерности массива
  StringGrid2.colcount:=elm;
  StringGrid4.colcount:=elm;
  end;
for i:=1 to elm do
    StringGrid1.Cells[i-1,0]:= IntToStr(Random(max)+1); // заполнение массива элементами
Button2.Visible:=true; // кнопка сортировки видима


end;

procedure TForm1.Button2Click(Sender: TObject); //сортировка
const
  bf = 6; //размер буфера
var
  buf :array [1..bf] of integer; // задаем буфер
  serBeg,ser,sera,serb,seraBeg,serbBeg : integer; //начало серии в массиве
  pust,pustf :integer; // число пустых элементов, серий в промежуточном массиве

  f,f1,f2: integer; // числа Фибоначчи
  p1,p2,p3: integer; // число элементов в отрезках
  m : array [1..3,1..2] of integer; // хранение длины и числа серий
  a,b,c :integer;
  h, min, s, ms:word;

procedure BubbleSort;    // подпрограмма сортировки пузырьком
var
i,j,x : integer;

begin
    for i :=1 to bf-1 do
      for j := i+1 to bf do
        if buf[i]>buf[j] then
          begin x := buf[i];
            buf[i] := buf[j];
            buf[j] := x
          end;
end;

begin
  serBeg:=0; // начало отсчета серии
  pust:=0; // обнуление количества пустых элементов
  ser:=0; // количество серий

  sera:=0; // число серий в массиве a
  serb:=0; // число серий в массиве b
  seraBeg:=1; // начало первой серии в массиве а
  serbBeg:=1; // начало первой серии в массиве b
T2.ColCount:=0;
T3.ColCount:=0;
T1.ColCount:=0;
Label6.Caption:= FloatToStr(Time);
while (serbeg<elm) do
begin
  for i:=1 to bf do   // перенос первой серии в буфер
  begin
    if (serBeg+i)<= elm then
      begin
        buf[i]:= StrToInt(StringGrid1.Cells [serBeg-1+i,0]); //считываем серию и заносим в буфер
        
      end
    else
      begin
        buf[i]:= 0;   // заполнение недостающих элементов нулями

        pust:=pust+1;   // счетчик лишних нулей
      end;
  end;


 BubbleSort;              // сортировка буфера пузырьком
 ser:=ser+1;              // счетчик общих серий

      // перенос из буфера в вспомогательный массив
T1.ColCount:=serBeg+bf; //размер вспомог массива
 for i:=1 to bf do   //запись серии из буфера в a
    T1.Cells[serBeg-1+i,0]:=IntToStr(buf[i]); // вывод буфера на 2
    serBeg := serBeg+bf;      //конец след серии

end;

// вычисление чисел Фибоначчи

f1:=0;f2:=1; // первые числа Фибоначчи
f:=f1+f2; //след число
while(f<ser) do
  begin
    f1:=f2;
    f2:=f;
    f:=f1+f2;
  end;
pustf:=f-ser;

// добавляем фиктивные серии
for j:=1 to pustf do
  begin
    ser:=ser+1;              // счетчик общих серий
    T1.ColCount:=serBeg+bf; //размер вспомог массива
    for i:=1 to bf do   //запись серии из буфера в a
        begin
        T1.Cells[serBeg-1+i,0]:=IntToStr(0); // вывод буфера на 2
        pust:= pust+1;
        end;
    serBeg := serBeg+bf;      //конец след серии

  end;


//распределение серий по массивам в второй запишемменьшее число Фибоначчи
p1:=bf*f1; //кол -во элементов во втором массиве
p2:=bf*f2; //кол -во элементов в третьем массиве
p3:=p1+p2; //общее число элементов


T2.ColCount:=p1;
T3.ColCount:=p2;
for i:=1 to p1 do               // Перенесем в 4 массив p1 элементов
T2.Cells[i-1,0]:=T1.Cells[i-1,0];
p1:=p1;
for i:=1 to p2 do               // Перенесем в 5 массив остальные элементы
T3.Cells[i-1,0]:=T1.Cells[i-1+p1,0];
// создадим массив для размера 3х3 столбцы - ленты, 1 строка - длина серии,
// 2 строка элементов в серии, 3 строка -элементов в массиве
// заполним его элементами



m[1,1]:=0;   // серий в 1 массиве
m[2,1]:=f1;   // серий в 2 массиве
m[3,1]:=f2;    // серий в 3 массиве
m[1,2]:=0;   // длина серий в 1 массиве
m[2,2]:=bf;   // длина серий в 2 массиве
m[3,2]:=bf;    // длина серий в 3 массиве

// перематываем все ленты на начало
i:=1;
j:=1;
k:=1;

while m[1,1]+m[2,1]+m[3,1]<>1 do //выполняем, пока на лентах не останется только одна серия
begin


 if m[1,1]=0 then  //сливаем 2и3 ленты на 1
  begin
    k:=1;  //начало ленты
    m[1,2]:=m[2,2]+m[3,2]; //новая длина серии в 1 ленте
    if m[2,1]<m[3,1] then T1.ColCount:=m[2,1]*m[1,2]
    else T1.ColCount:=m[3,1]*m[1,2];  //новая длина 1 ленты
    while m[2,1]*m[3,1]<>0 do //пока число серий во 2 или 3 ленте не станет равным нулю
     begin
      b:=m[2,2];  //длина выбраной серии во 2-й ленте
      c:=m[3,2];  //длина выбраной серии в 3-й ленте
      while (b*c)<>0 do
        begin
          if StrToInt(T2.Cells[i-1,0]) < StrToInt(T3.Cells[j-1,0])then   //сравниваем элементы
           begin
            T1.Cells[k-1,0]:= T2.Cells[i-1,0];
            i:=i+1;
            b:=b-1;
           end
          else
           begin
            T1.Cells[k-1,0]:= T3.Cells[j-1,0];
            j:=j+1;
            c:=c-1;
           end;
          k:=k+1;
        end;
      if b=0 then
       begin
        while c<>0 do
          begin
            T1.Cells[k-1,0]:= T3.Cells[j-1,0];
            j:=j+1;
            c:=c-1;
            k:=k+1;
          end;
       end
      else
       begin
        while b<>0 do
          begin
            T1.Cells[k-1,0]:= T2.Cells[i-1,0];
            i:=i+1;
            b:=b-1;
            k:=k+1;
          end;
       end;
      m[1,1]:=m[1,1]+1;
      m[2,1]:=m[2,1]-1;
      m[3,1]:=m[3,1]-1;
     end;

  k:=1; //перемотка ленты на начало
  end

else if m[2,1]=0 then  //сливаем 1и3 ленты на 2
  begin
    i:=1; //начало ленты
    m[2,2]:=m[1,2]+m[3,2]; //новая длина серии для 2 ленты
    if m[1,1]<m[3,1] then T2.ColCount:=m[1,1]*m[2,2]
    else T2.ColCount:=m[3,1]*m[2,2];  //новая длина 2 ленты
    while m[1,1]*m[3,1]<>0 do //пока число серий в 1 или 3 ленте не станет равным нулю
     begin
      a:=m[1,2];  //длина выбраной серии во 2-й ленте
      c:=m[3,2];  //длина выбраной серии в 3-й ленте
      while (a*c)<>0 do
        begin
          if StrToInt(T1.Cells[k-1,0]) < StrToInt(T3.Cells[j-1,0])then   //сравниваем элементы
           begin
            T2.Cells[i-1,0]:= T1.Cells[k-1,0];
            k:=k+1;
            a:=a-1;
           end
          else
           begin
            T2.Cells[i-1,0]:= T3.Cells[j-1,0];
            j:=j+1;
            c:=c-1;
           end;
          i:=i+1;
        end;
      if a=0 then
       begin
        while c<>0 do
          begin
            T2.Cells[i-1,0]:= T3.Cells[j-1,0];
            j:=j+1;
            c:=c-1;
            i:=i+1;
          end;
       end
      else
       begin
        while a<>0 do
          begin
            T2.Cells[i-1,0]:= T1.Cells[k-1,0];
            k:=k+1;
            a:=a-1;
            i:=i+1;
          end;
       end;
      m[2,1]:=m[2,1]+1;
      m[1,1]:=m[1,1]-1;
      m[3,1]:=m[3,1]-1;
     end;

  i:=1; // перемотка ленты 2 на начало
  end

else if m[3,1]=0 then  //сливаем 1и 2 ленты на 3
  begin
    j:=1; //начало ленты
    m[3,2]:=m[1,2]+m[2,2]; //новая длина серии 3
    if m[1,1]<m[2,1] then T3.ColCount:=m[1,1]*m[3,2]
    else T3.ColCount:=m[2,1]*m[3,2];  //новая длина 3 ленты
    while m[1,1]*m[2,1]<>0 do //пока число серий в 1 или 2 ленте не станет равным нулю
     begin
      a:=m[1,2];  //длина выбраной серии во 2-й ленте
      b:=m[2,2];  //длина выбраной серии в 3-й ленте
      while (a*b)<>0 do
        begin
          if StrToInt(T1.Cells[k-1,0]) < StrToInt(T2.Cells[i-1,0])then   //сравниваем элементы
           begin
            T3.Cells[j-1,0]:= T1.Cells[k-1,0];
            k:=k+1;
            a:=a-1;
           end
          else
           begin
            T3.Cells[j-1,0]:= T2.Cells[i-1,0];
            i:=i+1;
            b:=b-1;
           end;
          j:=j+1;
        end;
      if a=0 then
       begin
        while b<>0 do
          begin
            T3.Cells[j-1,0]:= T2.Cells[i-1,0];
            i:=i+1;
            b:=b-1;
            j:=j+1;
          end;
       end
      else
       begin
        while a<>0 do
          begin
            T3.Cells[j-1,0]:= T1.Cells[k-1,0];
            k:=k+1;
            a:=a-1;
            j:=j+1;
          end;
       end;
      m[3,1]:=m[3,1]+1;
      m[1,1]:=m[1,1]-1;
      m[2,1]:=m[2,1]-1;
     end;

  j:=1; // перемотка ленты 2 на начало

  end;

 
end;



// отбрасываем пустые элементы, выводим результаты
if m[1,1]=1 then
for i:=1 to elm do
  begin
    StringGrid2.Cells[i-1,0]:=T1.Cells[i-1+pust,0];
    StringGrid4.Cells[elm-i,0]:=T1.Cells[i-1+pust,0];


  end;
if m[2,1]=1 then
for i:=1 to elm do
  begin
    StringGrid2.Cells[i-1,0]:=T2.Cells[i-1+pust,0];
    StringGrid4.Cells[elm-i,0]:=T2.Cells[i-1+pust,0];

  end;
if m[3,1]=1 then
for i:=1 to elm do
  begin
    StringGrid2.Cells[i-1,0]:=T3.Cells[i-1+pust,0];
    StringGrid4.Cells[elm-i,0]:=T3.Cells[i-1+pust,0];

  end;
DecodeTime(Time-StrToFloat(Label6.Caption), h, min, s, ms);
Label6.Caption:= IntToStr(s)+'s '+ IntToStr(ms)+'ms';
Edit2.Visible:=true;

end;



procedure TForm1.Edit2Change(Sender: TObject);    //поиск элемента
begin
  Button3.Visible:= False;
  if (StrToInt(Edit2.Text) <= max) and (StrToInt(Edit2.Text) <> 0) then
    Button3.Visible:=True ;
  StringGrid2.Col:=0;
  StringGrid4.Col:=0;
end;

procedure TForm1.Button3Click(Sender: TObject);
(*реализация быстрого последовательного поиска. Алгоритм Q*)
var
  h, min, s, ms:word;
begin
  Label11.Caption:=FloatToStr(Time);
  StringGrid2.colcount:=elm+1;
  i:=1;                    //Q1 инициализация
  StringGrid2.Cells[elm,0]:= Edit2.Text;

  while StrToInt(Edit2.Text)<> StrToInt (StringGrid2.Cells[i-1,0])do   // Q2 сравнение
    i:=i+1;     //Q3 продвижение

  if i<=elm then   //Q4 конец файла?
    begin
      DecodeTime(Time-StrToFloat(Label11.Caption), h, min, s, ms); //расчет времени поиска
      Label11.Caption:= IntToStr(s)+'s '+ IntToStr(ms)+'ms';
      StringGrid2.Col:=i-1;     // показать результат поиска
      StringGrid4.Col:=elm-i;
    end

  else  Label11.Caption:='Такого элемента нет!';

end;

end.