Các phương pháp sắp xếp trong Pascal (Đầy đủ)

program cacppsx;
uses crt;
type mang=array[1..100] of integer;
var n,i,j,chon,x:integer; a:mang;
procedure nhap(var a:mang);
begin
write(`Ban can nhap bao nhieu phan tu n = `);
readln(n);
for i:=1 to n do
begin
write(` a [ `,i,` ] = `);
readln(a[i]);
end;
end;
procedure xuat(a:mang);
begin
writeln(`-----------DANH SACH GOM CAC PHAN TU SAU---------`);
For i:=1 to n do
writeln(` a [ `,i,` ] = `,a[i]);
writeln(`Ban An Enter de tiep tuc . . . . . . . . .`);
readln;
end;
procedure swap(var x,y:integer);
var temp:integer;
begin
temp:=x;x:=y;y:=temp;
end;
procedure selec;
var low,key:integer;
begin
for i:=1 to n-1 do
begin
low:=i;
key:=a[i];
for j:=i+1 to n do
begin
if a[j] begin
low :=j;
key:=a[j];
end;
swap(a[i],a[low]);
end;
end;
xuat(a);
end;
procedure insert;
begin
for i:=2 to n do
begin
j:=i;
while ((j>1)and (a[j] begin
swap(a[j],a[j-1]);
j:=j-1;
end;
end;
xuat(a);
end;
procedure binsort;
var l,r,m,x:integer;
begin
for i:=1 to n do
begin
x:=a[i];l:=1;r:=i-1;
while(l<=r) do
begin
m:=(l+r) div 2;
if (x r:=m-1
else
l:=m+1;
end;
for j:=i-1 downto 1 do
a[j+1]:=a[j];
a[l]:=x;
end;
xuat(a);
end;
procedure bubblesort;
begin
for i:=1 to n do
for j:=n downto i+1 do
if (a[j] swap(a[j],a[j-1]
);
xuat(a);
end;
procedure quicksort(l,r:integer);
begin
x:=a[(l+r) div 2];
i:=l; j:=r;
repeat
while (a[i] while (a[j]>x) do j:=j-1;
if (i<=j) then
begin
swap(a[i],a[j]);
i:=i+1;j:=j-1;
end;
until (i>j);
if (l if (iend;
procedure shift(l,r:integer);
var cont:boolean;
begin
i:=l;j:=2*i;x:=a[i];cont:=true;
while ((j<=r) and cont) do
begin
if (j if (a[j] if (a[j] cont:=false
else
begin
a[i]:=a[j];
i:=j;
j:=2*i;
end;
end;
a[i]:=x;
end;
procedure create(n:integer);
var l:integer;
begin
l:=n div 2;
while(l>0) do
begin
shift(l,n);
l:=