heapsort.txt

<<<<<<< HEAD
//Program pobrany ze strony www.algorytm.org
//Opracował Michał Knasiecki
unit Unit1;
 
interface
 
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
 
type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
ListBox2: TListBox;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
tablica=array[1..10]of integer;
var
Form1: TForm1;
a:tablica;//Tablica źródlowa
n:integer; //Liczba elementów (w listbox1) do posortowania
implementation
 
{$R *.DFM}
procedure sort_up(k:integer); //Porządkowanie stogu od dolu
var l,v:integer;
begin
v:=a[k];
l:=k div 2;
while a[l]<v do
begin
a[k]:=a[l];
k:=l;
l:=l div 2;
end;
a[k]:=v;
end;
procedure sort_dn(k:integer);  //Porządkowanie stogu od góry
var j,v,p:integer;
begin
v:=a[k];
while (k<=(n div 2)) do
begin
j:=2*k;
if (j<n)and( a[j]<a[j+1]) then j:=j+1;
if v<a[j] then
begin
p:=a[k];
a[k]:=a[j];
a[j]:=p;
k:=j;
end else begin a[k]:=v;break;end;
end;
end;
procedure delete_root; //Usuwanie korzenia (największego elementu
var p:integer;
begin                  //i przenoszenie ostatniego liscia w miejsce korzenia
p:=a[n];//zapisanie ostatniego liscia
a[n]:=a[1]; //przeniesienie korzenia (największego elementu) do tablicy od końca
dec(n); //Po usunięciu korzenia tablica źródlowa zmniejsza się o 1
a[1]:=p; //Ostatni lisc staje się korzeniem
sort_dn(1); //Przywracanie porządku po zmianie korzenia
end;
procedure build_heap;//porządkowanie stogu w dól zaczynając od poprzednika ostatniego liscia
var i:integer;
begin
for i:=(n div 2) downto 1 do sort_dn(i);
end;
procedure heap_sort; //Glówna procedura
var m:integer;
begin
m:=n;
build_heap;//po zbudowaniu drzewa binarnego nalerzy je uporządkowac tak, by spelnialo warunek stogu
repeat
delete_root; //Gdy stóg jest gotowy można usuwac korzeń
until n=1;
n:=m;
end;
procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
begin
n:=10;
for i:=1 to 10 do a[i]:=strtoint(listbox1.items[i-1]); //pobieranie elementów z listboxa do tablicy wejsciowej
heap_sort;//sortowanie
listbox2.clear;
for i:=1 to 10 do listbox2.items.add(inttostr(a[i]));//wypisywanie tablicy wynikowej w listbox
end;
procedure TForm1.Button2Click(Sender: TObject);
var i:integer;
begin
randomize;
listbox1.Clear;
for i:=1 to 10 do listbox1.items.add(inttostr(random(100)));
end;
 
=======
//Program pobrany ze strony www.algorytm.org
//Opracował Michał Knasiecki
unit Unit1;
 
interface
 
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
 
type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
ListBox2: TListBox;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
tablica=array[1..10]of integer;
var
Form1: TForm1;
a:tablica;//Tablica źródlowa
n:integer; //Liczba elementów (w listbox1) do posortowania
implementation
 
{$R *.DFM}
procedure sort_up(k:integer); //Porządkowanie stogu od dolu
var l,v:integer;
begin
v:=a[k];
l:=k div 2;
while a[l]<v do
begin
a[k]:=a[l];
k:=l;
l:=l div 2;
end;
a[k]:=v;
end;
procedure sort_dn(k:integer);  //Porządkowanie stogu od góry
var j,v,p:integer;
begin
v:=a[k];
while (k<=(n div 2)) do
begin
j:=2*k;
if (j<n)and( a[j]<a[j+1]) then j:=j+1;
if v<a[j] then
begin
p:=a[k];
a[k]:=a[j];
a[j]:=p;
k:=j;
end else begin a[k]:=v;break;end;
end;
end;
procedure delete_root; //Usuwanie korzenia (największego elementu
var p:integer;
begin                  //i przenoszenie ostatniego liscia w miejsce korzenia
p:=a[n];//zapisanie ostatniego liscia
a[n]:=a[1]; //przeniesienie korzenia (największego elementu) do tablicy od końca
dec(n); //Po usunięciu korzenia tablica źródlowa zmniejsza się o 1
a[1]:=p; //Ostatni lisc staje się korzeniem
sort_dn(1); //Przywracanie porządku po zmianie korzenia
end;
procedure build_heap;//porządkowanie stogu w dól zaczynając od poprzednika ostatniego liscia
var i:integer;
begin
for i:=(n div 2) downto 1 do sort_dn(i);
end;
procedure heap_sort; //Glówna procedura
var m:integer;
begin
m:=n;
build_heap;//po zbudowaniu drzewa binarnego nalerzy je uporządkowac tak, by spelnialo warunek stogu
repeat
delete_root; //Gdy stóg jest gotowy można usuwac korzeń
until n=1;
n:=m;
end;
procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
begin
n:=10;
for i:=1 to 10 do a[i]:=strtoint(listbox1.items[i-1]); //pobieranie elementów z listboxa do tablicy wejsciowej
heap_sort;//sortowanie
listbox2.clear;
for i:=1 to 10 do listbox2.items.add(inttostr(a[i]));//wypisywanie tablicy wynikowej w listbox
end;
procedure TForm1.Button2Click(Sender: TObject);
var i:integer;
begin
randomize;
listbox1.Clear;
for i:=1 to 10 do listbox1.items.add(inttostr(random(100)));
end;
 
>>>>>>> be9f3070b137205a86b918468c046f88354e9fbe
end.