Cac thuat toan sap xep

program Cac_Thuat_Toan_SX;
uses crt,graph;
const nmax=20;
type
mang= array[1..nmax] of integer;
strn= string[nmax];
bangkt= array[1..nmax] of strn;
Obj= object
procedure Menuchinh;
procedure Move(n,x1,y1,x2,y2,h:integer;b:boolean;
nd:bangkt;mnc,mcc,mnr,mcr:integer;var chon:integer);
procedure Bye;
end;
var
gd,gm: integer;
chon,chon_q,d,k,i,j,tg,toi,n,x1,y1,x2,y2: integer;
chon1,ch: char;
a,b,c,Item,tamx,tamy,r: mang;
Ok: Boolean;
Ob_ject: Obj;
Phim: bangkt;
(*======================================================*)
procedure Gioi_thieu;
Procedure Duongchay(ax,ay,bx,by:integer;mau:byte);
begin
setfillstyle(1,mau);
bar(ax,ay,bx,by);
end;
begin
i:=0;j:=640; k:=1600;
Setbkcolor(black);

settextstyle(1,0,4);
setcolor(15);
outtextxy(90,120,'CAI DAT MOT SO THUAT TOAN ');
outtextxy(257,160,'SAP XEP');
settextstyle(0,0,0);
setcolor(12);
outtextxy(140,220,'---------------------o0o----------------------');
setcolor(1);
repeat
j:=j-1;
i:=i+1; k:=k-1 ;
if j=0 then k:=850;
if k=0 then j:=850;
settextstyle(2,0,6);
setcolor(15);
outtextxy(j,420,'Nhan Phim Bat Ky de Tiep Tuc...');
outtextxy(k,420,'Nhan Phim Bat Ky De Tiep Tuc...');
delay(10);
duongchay(0,422,getmaxx,439,1);
until (keypressed) or (i>1500);
if i>5 then exit;
end;
(*==========================================================
==*)
procedure nhap;
begin
textbackground(1);
clrscr;
textcolor(14);
Window(10,5,70,20);

write('Ban hay nhap vao so phan tu cua mang can sap xep (n>0,n<=11), n= ');
repeat
readln(n);
if (n<=0) or (n>11) then
begin
clrscr;
write('Moi ban nhap lai, n= ');
end;
until (n>0) and (n<=11);
for i:=1 to n do
begin
repeat
clrscr;
textbackground(1);
writeln('Mang can sap co ',n,' phan tu:');
writeln('Gia tri cua cac phan tu 3<a[i]<=30:');
writeln;
for j:=1 to i-1 do writeln('a[',j,']= ',a[j]);
Write('Nhap a[',i,']= ');
readln(a[i]);
if (a[i]<=3) or (a[i]>30) then
begin
sound(1047);delay(150); nosound;
textcolor(15);write('Nhap lai!'); delay(200);
textcolor(14);
end;
until (a[i]>3) and (a[i]<=30);
end;
clrscr;
writeln('Mang can sap co ',n,' phan tu:'); writeln;

for j:=1 to i do writeln('a[',j,']= ',a[j]);
writeln;
textcolor(15); write('An Enter de tiep tuc !');
readln;
end;
(*==========================================================
===*)
procedure tron(x,y,bk:integer);
var xau:string;
begin
setfillstyle(1,12);
setcolor(12);
circle(x,y,bk);
floodfill(x,y,12);
str(bk,xau);
setcolor(15);
outtextxy(x-4,y-3,xau);
end;
(*==========================================================
===*)
procedure xoa(x,y,bk: integer);
begin
setfillstyle(1,1);
setcolor(1);
circle(x,y,bk);
floodfill(x,y,1);
end;
(****************************************************************)
procedure selection;
begin

for i:=1 to n do r[i]:=a[i];
setbkcolor(1);
cleardevice;
settextstyle(6,0,2);
setcolor(15);
outtextxy(160,50,'Day la kieu sap xep SELECTION SORT');
settextstyle(0,0,0);
setcolor(14);
outtextxy(150,450,'An phim bat ky de tiep tuc, Esc de thoat !');
for i:= 1 to n do
begin
tamy[i]:=350;
tamx[i]:=38+(i-1)*62;
tron(tamx[i],tamy[i],r[i]);
end;
ch:=readkey;
if ch=#27 then exit
else
begin
for i:=1 to n-1 do
begin
k:=i;
for j:=i+1 to n do
if r[j] < r[k] then k:=j;
if k<>i then
begin
ch:=readkey;
if ch=#27 then exit
else
begin

tg:=r[i];
tron(tamx[i],tamy[i]-120,tg);
xoa(tamx[i],tamy[i],r[i]);
end;
ch:=readkey;
if ch=#27 then exit
else
begin
r[i]:=r[k];
tron(tamx[i],tamy[i],r[i]);
xoa(tamx[k],tamy[k],r[k]);
end;
ch:=readkey;
if ch=#27 then exit
else
begin
r[k]:=tg;
tron(tamx[k],tamy[k],r[k] );
xoa(tamx[i],tamy[i]-120,tg);
end;
end;
end;
end;
setcolor(1);
outtextxy(150,450,'An phim bat ky de tiep tuc, Esc de thoat !');
setcolor(15);
outtextxy(100,450,'Mang da duoc sap xep, an Enter de ve menu chinh !');
textcolor(1);
readln;
end;

(*==========================================================
=*)
procedure insertion;
begin
for i:=1 to n do r[i]:=a[i];
setbkcolor(blue);
cleardevice;
settextstyle(6,0,2);
setcolor(15);
outtextxy(160,50,'Day la kieu sap xep INSERTION SORT');
settextstyle(0,0,0);
setcolor(14);
outtextxy(150,450,'An phim bat ky de tiep tuc, Esc de thoat !');
for i:= 1 to n do
begin
tamy[i]:=340;
tamx[i]:=38+(i-1)*62;
tron(tamx[i],tamy[i],r[i]);
end;
ch:=readkey;
if ch=#27 then exit
else
begin
for i:=2 to n do
begin
tg:=r[i];
tron(tamx[i],tamy[i]-120,tg);
xoa(tamx[i],tamy[i],30);
ch:=readkey;
if ch=#27 then exit

else j:=i-1;
while tg<r[j] do
begin
xoa(tamx[j+1],tamy[j+1],32);
r[j+1]:=r[j];
tron(tamx[j+1],tamy[j+1],r[j+1]);
xoa(tamx[j],tamy[j],30);
ch:= readkey;
if ch=#27 then exit
else j:=j-1;
end;
r[j+1]:=tg;
tron(tamx[j+1],tamy[j+1],r[j+1]);
xoa(tamx[i],tamy[i]-120,30);
ch:=readkey;
if ch=#27 then exit
end;
end;
setcolor(1);
outtextxy(150,450,'An phim bat ky de tiep tuc, Esc de thoat !');
setcolor(15);
outtextxy(100,450,'Mang da duoc sap xep, an Enter de ve menu chinh !');
setcolor(1);
textcolor(1);
readln;
end;
(*==========================================================
=========*)
procedure bubble;
begin

for i:=1 to n do r[i]:=a[i];
setbkcolor(1);
cleardevice;
settextstyle(6,0,2);
setcolor(15);
outtextxy(60,150,'Day la kieu sap xep BUBBLE SORT');
settextstyle(0,0,0);
setcolor(14);
outtextxy(100,300,'An phim bat ky de tiep tuc,');
outtextxy(100,320,'An Esc de thoat !');
for i:= 1 to n do
begin
tamx[i]:=450;
tamy[i]:=25+(i-1)*60;
tron(tamx[i],tamy[i],r[i]);
end;
ch:=readkey;
if ch=#27 then exit
else
begin
for i:=n downto 1 do
for j:=2 to i do
if r[j] < r[j-1] then
begin
tg:=r[j-1];
ch:=readkey;
if ch=#27 then exit
else
begin
tron(tamx[j-1]+120,tamy[j-1],tg);

xoa(tamx[j-1],tamy[j-1],30);
end;
ch:=readkey;
if ch=#27 then exit
else
begin
r[j-1]:=r[j];
tron(tamx[j-1],tamy[j-1],r[j-1] );
xoa(tamx[j],tamy[j],30);
end;
r[j]:=tg;
ch:=readkey;
if ch=#27 then exit
else
begin
tron(tamx[j],tamy[j],r[j]);
xoa(tamx[j-1]+120,tamy[j-1],30);
end;
end;
end;
setcolor(1);
outtextxy(100,300,'An phim bat ky de tiep tuc,');
outtextxy(100,320,'An Esc de thoat !');
setcolor(15);
outtextxy(80,280,'Mang da duoc sap xep.');
outtextxy(80,300,'An Enter de ve menu chinh !');
textcolor(1);
readln;
end;
(*==========================================================

==*)
Procedure ShellSort;
label 0;
Var i,j,q,m:integer;
begin
for i:=1 to n do b[i]:=a[i];
cleardevice;
setbkcolor(1);
settextstyle(6,0,2);
setcolor(15);
outtextxy(160,50,'Day la kieu sap xep SHELL SORT');
settextstyle(0,0,0);
setcolor(14);
outtextxy(150,450,'An phim bat ky de tiep tuc, Esc de thoat !');
for i:= 1 to n do
begin
tamy[i]:=340;
tamx[i]:=38+(i-1)*62;
tron(tamx[i],tamy[i],b[i]);
end;
ch:=readkey;
if ch=#27 then exit ;
q:=1;
repeat q:=3*q+1;until q>n;
repeat
q:=q div 3;
for i:= q+1 to n do
begin
xoa(100,200,30);
m:=b[i];

tron(100,200,m);
xoa(tamx[i],tamy[i],30);
ch:=readkey;
if ch=#27 then exit;
j:=i;
while b[j-q]>m do
begin
b[j]:=b[j-q];
xoa(tamx[j],tamy[j],30);
xoa(tamx[j-q],tamy[j-q],30);
tron(tamx[j],tamy[j],b[j]);
ch:=readkey;
if ch=#27 then exit ;
j:=j-q;
if j<q then goto 0
end;
0: begin
b[j]:=m;
xoa(tamx[j],tamy[j],30);
tron(tamx[j],tamy[j],b[j]);
end;
end;
xoa(100,200,30);
for i:=1 to n do xoa(tamx[i],tamy[i],30);
for i:=1 to n do tron(tamx[i],tamy[i],b[i]);
ch:=readkey;
if ch=#27 then exit
until q=1;
for i:=1 to n do write(b[i]:3);
setcolor(1);

outtextxy(150,450,'An phim bat ky de tiep tuc, Esc de thoat !');
setcolor(15);
outtextxy(100,450,'Mang da duoc sap xep, an Enter de ve menu chinh !');
textcolor(1);
readln;
end;
(*==========================================================
======*)
Procedure Quick;
procedure tronq(x,y,bk:integer;mau:byte);
var xau:string;
begin
setfillstyle(1,mau);
setcolor(mau);
circle(x,y,bk);
floodfill(x,y,mau);
str(bk,xau);
setcolor(15);
outtextxy(x-4,y-3,xau);
end;
Procedure qs1(l,r:integer);
var v,t,i,j:integer;
begin
setbkcolor(1);
cleardevice;
settextstyle(6,0,2);
setcolor(15);
outtextxy(160,50,'Day la kieu sap xep QUICK SORT');
settextstyle(0,0,0);
setcolor(14);

outtextxy(150,450,'An phim bat ky de tiep tuc, Esc de thoat !');
for i:=1 to n do
begin
tamy[i]:=350;
tamx[i]:=38+(i-1)*62;
end;
for i:=1 to n do tron(tamx[i],tamy[i],b[i]);
if r>l then
begin
ch:=readkey;
if ch=#27 then exit else
begin
v:=b[r];
tronq(tamx[r],tamy[r],v,10);
setcolor(11);
outtextxy(tamx[r]-10,tamy[r]+40,'Key');
setcolor(15);
end;
i:=l-1; j:=r;
ch:=readkey;
if ch=#27 then exit else
begin
repeat
repeat i:=i+1; until b[i]>=v;
repeat j:=j-1; until b[j]<=v;
tronq(tamx[i],tamy[i],b[i],cyan);
tronq(tamx[j],tamy[j],b[j],cyan);
ch:=readkey;
if ch=#27 then exit else
begin

t:=b[i];
tron(400,200,t);
xoa(tamx[i],tamy[i],30);
end;
ch:=readkey;
if ch=#27 then exit else
begin
b[i]:=b[j];
tron(tamx[i],tamy[i],b[j] );
xoa(tamx[j],tamy[j],30);
end;
ch:=readkey;
if ch=#27 then exit else
begin
b[j]:=t;
tron(tamx[j],tamy[j],b[j]);
xoa(400,200,30);