Heap Sort
This algorithm is generally used in mass data sorting that does not fit in memory.
The Algorithm
Pascal Source Code
{
This program reads the array from text file dizi.dat. Then using Heap Sort method
interactively sorting process is shown in a 640x480x16 VGA graphical mode.
Sample array:
1 3 43 43 54 66 76 73 4 9 44 15 45 34 55 89 32 20 7 4
}
uses crt,graph;
const
radius = 10;
esX = 4;
esY = 2;
FontSize = 3;
X:array[1..63]of integer=(320,160,480,80,240,400,560,40,120,200,280,360,
440,520,600,20,60,100,140,180,220,260,18,300,340,
380,420,460,500,540,580,620,10,30,50,70,90,110,
130,150,170,190,210,230,250,270,290,310,330,350,
370,390,410,430,450,470,490,510,530,550,570,590,
610,630);
Y:array[1..63]of integer=(10,40,40,70,70,70,70,100,100,100,100,100,100,100,
100,130,130,130,130,130,130,130,130,130,130,130,
130,130,130,130,130,160,160,160,160,160,160,160,
160,160,160,160,160,160,160,160,160,160,160,160,
160,160,160,160,160,160,160,160,160,160,160,160,
160);
type
tree = array[1..63] of integer;
var
A:tree; n:byte; ch:char;
MaxX,MaxY : word;
FillInfo: FillSettingsType;
Procedure Read_Array(var A:tree;var n:byte);
var dosya:Text; i, j, k , code:word; strg,strn:string;
Begin
{i-}
assign(dosya,'DIZI.DAT');
reset(dosya);
if ioresult<>0 then
begin
write('couldn't open DIZI.DAT...');
halt(1);
end;
{i+}
i:=0;
while not EOF(dosya) do
begin
strg:='';
strn:='';
j:=0;
while not EOLN(dosya) do
begin
read(dosya,ch);
insert(ch,strn,length(strn)+1);
inc(j);
end;
insert(' ',strn,length(strn)+1);
if j>255 then
begin
writeln;write('Line is bigger than 255 characters...');
halt(1);
end;
for j:=1 to length(strn)+1 do
begin
if (copy(strn,j,1)<>' ') then
begin
insert(copy(strn,j,1),strg,length(strg)+1);
end
else
begin
val(strg,k,code);
if code<>0 then
begin
writeln; write('Couldn't read from file. Don't put spaces in the end of file...');
halt(1);
end;
inc(i);
A[i]:=k;
strg:='';
k:=0;
end;
end;
readln(dosya);
end;
if i>63 then n:=63
else n:=i;
close(dosya);
end;
Procedure Initialize_Graphic_Mode(var MaxX, MaxY : word);
var
Gd, Gm : Integer;
Begin
Gd := detect;
InitGraph(Gd, Gm, '');
if GraphResult <> grOk then
begin
writeln; write('Graphical mode couldn't opened...');
Halt(1);
end;
SetTextStyle(SmallFont, HorizDir, FontSize);
GetFillSettings(FillInfo);
with FillInfo do
SetFillStyle(Pattern, 0);
MaxX := GetmaxX;
MaxY := GetmaxY;
End;
Procedure Write_On_Screen(A : tree; nn : byte; tip : byte);
var
i:byte; S:string;
Begin
SetTextStyle(SmallFont, HorizDir, FontSize+2);
if tip=1 then
outtextxy(1,Y[nn]+30,'original array...')
else
outtextxy(1,Y[nn]+50,'Sorted array...');
if tip=1 then
moveto(1,Y[nn]+40)
else
moveto(1,Y[nn]+60);
for i:=1 to nn do
begin
Str(A[i], S);
outtext(S);outtext(' ');
S:='';
end;
End;
Procedure Draw_Tree(var A : tree; nn:byte);
var
i:integer; s:string[5]; esXX:byte;
tmpX,tmpY:real; X1,X2,Y1,Y2:word;
Begin
setcolor(black);
with FillInfo do
SetFillStyle(Pattern, 0);
rectangle(0,0,MaxX,MaxY);
FillEllipse(X[1],Y[1],radius,radius);
setcolor(white);
circle(X[1], Y[1], radius);
setcolor(Yellow);
if A[1]<10 then esXX:=esX-1
else esXX:=esX+2;
Str(A[1], S);
outtextxy(X[1] - esXX, Y[1] - esY, S);
S:='';
for i:=2 to nn do
begin
if A[i]<10 then esXX:=esX-1
else esXX:=esX+2;
setcolor(black);
FillEllipse(X[i],Y[i],radius,radius);
setcolor(white);
circle(X[i], Y[i], radius);
Str(A[i], S);
setcolor(Yellow);
outtextxy(X[i] - esXX, Y[i] - esY, S);
S:='';
if (i mod 2)=0 then
begin
tmpX:=( radius*(X[i div 2]-X[i]) )/
( sqrt( sqr(X[i div 2] - X[i]) + sqr(Y[i] - Y[i div 2]) ) );
tmpY:=( radius*(Y[i div 2]-Y[i]) )/
( sqrt( sqr(X[i div 2] - X[i]) + sqr(Y[i] - Y[i div 2]) ) );
X1:= round(X[i div 2] - tmpX);
Y1:= round(Y[i div 2] - tmpY);
X2:= round(X[i] + tmpX);
Y2:= round(Y[i] + tmpY);
Line(X1,Y1,X2,Y2);
end
else
begin
tmpX:=( radius*(X[i] - X[(i-1) div 2]) )/
( sqrt( sqr(X[i] - X[(i-1) div 2]) + sqr(Y[i] - Y[(i-1) div 2])
tmpY:=( radius*(Y[i]-Y[(i-1) div 2]) )/
( sqrt( sqr(X[i] - X[(i-1) div 2]) + sqr(Y[i] - Y[(i-1) div 2])
X1:= round(X[(i-1) div 2] + tmpX);
Y1:= round(Y[(i-1) div 2] + tmpY);
X2:= round(X[i] - tmpX);
Y2:= round(Y[i] - tmpY);
Line(X1,Y1,X2,Y2);
end;
end;
End;
Procedure Monitor_Changes(var A:tree; t,k:integer; size:byte; color:byte);
var
S:string; esXX:byte;
Begin
setcolor(white);
with FillInfo do
SetFillStyle(Pattern, 0);
FillEllipse(X[t],Y[t],radius,radius);
FillEllipse(X[k],Y[k],radius,radius);
setcolor(color);
if A[t]<10 then esXX:=esX-1
else esXX:=esX+2;
str(A[t],S);
outtextxy(X[t] - esXX, Y[t] - esY, S);
S:='';
if A[k]<10 then esXX:=esX-1
else esXX:=esX+2;
str(A[k],s);
outtextxy(X[k] - esXX, Y[k] - esY, s);
S:='';
End;
Procedure Heap_Tree(var A:tree; nn:byte);
var
i,i2,i3,j,tmp:integer;
Begin
for i:=1 to ((nn+1) div 2) do
begin
i2:=i+i; i3:=i+i+1;
if (A[i]>A[i2])and((i2)<=nn) then
begin
Monitor_Changes(A,i,i2,FontSize,12);
delay(6000); {<-------------DELAY-------------}
tmp:=A[i];
A[i]:=A[i2];
A[i2]:=tmp;
Monitor_Changes(A,i,i2,FontSize,12);
Draw_Tree(A,nn);
Heap_Tree(A,nn);
end
else if (A[i]>A[i3])and((i3)<=nn) then
begin
Monitor_Changes(A,i,i3,FontSize,12);
delay(6000); {<-------------DELAY-------------}
tmp:=A[i];
A[i]:=A[i3];
A[i3]:=tmp;
Monitor_Changes(A,i,i3,FontSize,12);
Draw_Tree(A,nn);
Heap_Tree(A,nn);
end;
end;
End;
Procedure Heap_Sort(var A:tree;nn:byte);
var
i,j,m:byte; k:integer;
Begin
Write_On_Screen(A,nn,1);
Draw_Tree(A,nn);
Heap_Tree(A,nn);
delay(30000); {<-------------DELAY-------------}
m:=nn;
for i:=1 to nn do
begin
k:=A[1];
for j:=1 to nn-1 do A[j]:=A[j+1];
A[nn]:=k;
m:=m-1;
Draw_Tree(A,nn);
Heap_Tree(A,m);
end;
End;
BEGIN
clrscr;
Read_Array(A,n);
Initialize_Graphic_Mode(MaxX,MaxY);
Heap_Sort(A,n);
Write_On_Screen(A,n,2);
Repeat ch:=readkey until ch=#27;
Closegraph;
END.
Sample Execution
