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;
end.