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

[alexBlack]

Пишем дополнительную процедурку:

procedure TForm1.ViewArray(ar:op);
var s:String;
     i:integer;
begin
    s := '';
    for i:=low(ar) to high(ar) do 
       s := s + intToStr(ar[i])+' ';
    memo1.lines.add(s);
end;

Из Вашего кода:

    
    ...
    BubbleSort(ar);   
    if not fl then begin  
       Write(FileA,ar);     ViewArray(ar); 
       fl:=true;   
    end else begin  
       Write(FileB,ar);     ViewArray(ar);
       fl:=false;   
    end;

[maLoy*508]

В memo на выходе получаю что-то непонятное...
исходный массив: 0 1 2 3 4 5 6 7 8 9
на выходе: 2_3_3_14_65_512_1242708_16777216_54 0090416_2010419711_
3_3_14_65_512_1242708_16777216_5400 90416_540221490_2010419711_
3_14_65_512_1242708_16777216_540090 416_540221490_540352564_2010419711_
14_65_512_1242708_16777216_54009041 6_540221490_540352564_540483638_201 0419711_
65_512_1242708_16777216_221847608_5 40090416_540221490_540352564_540483 638_2010419711_

Код

procedure TForm1.Button3Click(Sender: TObject);
var
i:integer;
ar:op;
fl:boolean;
file1:file of integer;
fileA:file of op;
fileB:file of op;
letter:char;
st:string;

procedure ViewArray(ar:op);
var
s:String;
i:integer;
begin
    s := '';
    for i:=low(ar) to high(ar) do 
       s := s + intToStr(ar[i])+'_';
    memo2.lines.add(s);
end;


begin
 i:=0;
 st:='';
assignfile(fileA,'a.txt');
assignfile(fileB,'b.txt');
assignfile(file1,'ishod.txt');//ExtractFileName(OpenDialog1.FileName));
reset(File1);
reset(FileA);
reset(FileB);
  i := 0;
  fl:=false;
while not eof(file1) do begin
   inc(i);
  read(file1,ar[i]);

     If i=10 then
  begin
      // Здесь набрался полный блок
       // его можно сортировать и записать
      BubbleSort(ar);
          if not fl then
        begin
          Write(FileA,ar);  ViewArray(ar);
         fl:=true;
         end
       else
         begin
           Write(FileB,ar); ViewArray(ar);
           fl:=false;
         end;

       i:= 0;

    end;

if ( i > 0) then
begin
  // А вот здесь остаток - часть блока длиной i
 BubbleSort(ar);
          if not fl then
        begin
         Write(FileA,ar);     ViewArray(ar);
         fl:=true;
         end
       else
         begin
            Write(Fileb,ar); ViewArray(ar);
            fl:=false;
         end;

       i:= 0;
    end;
end;
closefile(File1);
closefile(FileA);
closeFile(FileB);
end;

[shamm]

Спасибо за ответы
Очень многое взял для своего курсовика

[shamm]

procedure TForm1.Button2Click(Sender: TObject); //сортировка
const
bf = 6; //размер буфера
var
buf :array [1..bf] of integer; // задаем буфер
serBeg,ser,sera,serb,seraBeg,serbBe g : 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;

[shamm]

продолжение
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;


end.

[shamm]

Это что у меня получилось в конечном итоге, может кому пригодится

[inspectoh]

всем доброго времени суток. читая тему, я увидел, что числа нужно брать не совсем простые, числа нужно брать фибоначи, а у меня задание на ввод массива рандомного от 1 до 10000 элементов и сортировка его методом многофазной сортировки. то есть я ввёл массив, реализовал запись лент в стринггрид, но что дальше делать пока не совсем понял. у меня получается 5 лент и в каждой ленте от 1 до 200 чисел, произвольных, т.е. отрицательных и положительных. можете советом помочь?