Сортування даних - пірамідальне сортування (стр. 2 из 2)
алгоритм програма елемент вікно
Опис використаних в реалізації методу процедур та функцій
Процедура Swap
Procedure Swap(i, j : Integer)
Переставляє місцями елементи масиву A[i] та A[j] за умови , якщо A[i] < A[j].
Процедура Conflict
Procedure Conflict(i, k : Integer)
Вирішує сімейний конфлікт у дереві : якщо найбільший із синів більше, ніж батько, то переставляються батько і цей син (процедура Swap).
Процедура SortTree
Procedure SortTree(i : Integer)
Будує сортуюче дерево за правилами :
1. A[1] - корінь дерева ;
2. Якщо A[i] - вузол дерева і 2i , то A[2*i] - вузол - “лівий син” вузла A[i]
3. Якщо A[i] - вузол дерева і 2i + 1 , то A[2*i+1] - вузол - “правий син” вузла A[i]
Правила 1-3 визначають у масиві структуру дерева, причому глибина дерева не перевершує [log2 n] + 1. Вони ж задають спосіб руху по дереву від кореня до листків. Рух вгору задається правилом 4:
4. Якщо A[i] - вузол дерева та i > 1, то A[i mod 2] - вузол - “батько” вузла A[i].
Процедура Show_result
Procedure Show_result
Виводить в циклі елементи відсортованого масиву на екран.
Процедура get_data
Procedure get_data
Зчитує значення елементів масиву для сортування.
Користувацьке вікно ( форма )
var
Form1: TForm1;
A:array[1..20] of real;
N,k:integer;
implementation
Procedure Swap(i, j : Integer);
Var b : Real;
Begin
If a[i] < a[j] then
begin
b := a[i];
a[i] := a[j];
a[j] := b
end
End;
Procedure Conflict(i, k : Integer);
Var j : Integer;
Begin
j := 2*i;
If j = k then
Swap(i, j)
else
if j < k then
begin
if a[j+1] > a[j] then
j := j + 1;
Swap(i, j);
Conflict(j, k)
End End;
Procedure SortTree(i : Integer);
begin
If i <= n div 2 then
begin
SortTree(2*i);
SortTree(2*i+1);
Conflict(i, n)
end
end;
procedure Show_result;
var i:integer;
begin
Form1.label1.Caption:='';
for i:=1 to N do
begin
Form1.Label1.Caption:=Form1.Label1.Caption+' '+floattostr(A[i]);
Form1.stringGrid1.Cells[i-1,0]:=floattostr(A[i]);
end; end;
procedure get_data;
var i:integer;
begin
for i:=1 to N do
begin
if Form1.StringGrid1.Cells[i-1,0]<>'' then
try
A[i]:=strtoint(Form1.StringGrid1.Cells[i-1,0])
except on EConvertError do showmessage('Недопустимый формат данных ! Присвоено значение "0"'); end
else
showmessage('Обнаружено пустое поле ! Присвоено значение "0"');
end;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var i:integer;
begin
get_data;
Label1.Caption:='';
Label1.Enabled:=true;
SortTree(1);
For k := n downto 2 do
begin
Swap(k, 1);
Conflict(1, k - 1) end;
show_result; end;
procedure TForm1.Button1Click(Sender: TObject);
begin
try
N:=strtoint(edit1.Text);
except on EConvertError do
edit1.Clear end;
Form1.Height:=250;
label1.visible:=true;
stringGrid1.Visible:=true;
bitbtn1.Visible:=true;
stringGrid1.ColCount:=n;
stringGrid1.RowCount:=1;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.Height:=120; end; end