BÀI TẬP LẬP TRÌNH - DEMO CÁC PHƯƠNG PHÁP SẮP XẾP

Program BAI_TAP_CHU_DE_LON1;
Uses Dos,Crt,graph;
Type mang = array [1..10] of string;
m1 = array [1..21] of byte;
Const
dong = 10;
old = 15;
tg = 60000;
MAU=159;
mau2=120;
Var
k:array[1..10] of string;
dc:char;
Gd,Gm : Integer;
Radius,T : Integer;
a : m1;
f1,f2:m1;
n,l,i,h1,h2,p,pm : byte;
ss,hv : word;
Procedure ConTro(co:byte);
Var R : Registers;
Begin
R.AH:=$01;
If co = 0 Then R.CX:=$2000
Else R.CX:=$0B0C;
Intr($10,R);
End;
Procedure writeXYso(x,y,tt,i:byte);
Begin
textattr:=tt;
gotoxy(x,y-1);write('ÚÄÄ¿');

gotoxy(x,y);write('³',a[i]:2,'³');
gotoxy(x,y+1);write('ÀÄÄÙ');
textattr:=old;
End;
{-----------------------Nhap du lieu------------------------------}
Procedure nhapdulieu (var dulieu:m1);
Var i: integer;
Begin
clrscr;
write('Day so can sap xep co bao nhieu so: ');readln(n);
randomize;
For i:=1 to n do dulieu[i]:=random(100);
end;
Procedure xuat(f:m1);
Var i:byte;
Begin clrscr;
for i:=1 to n do
begin
writexyso(i*4-3,dong,old,i);
end;
End;
Procedure xuat1(f:m1;n:byte);
Var i:byte;
Begin clrscr;
for i:=1 to n do
begin writexyso(i*4-3,dong,mau,i);end;
End;
procedure banphim;
var i:integer;
begin clrscr;

ConTro(1);
write('Nhap vao so phan tu : ');readln(n);
for i:=1 to n do
begin
gotoxy(5,18);write('Nhap vao phan tu thu ',i,' : ');readln(a[i]);
xuat1(a,i);
gotoxy(5,18);write(' ');
end;
ConTro(0);
end;
Procedure writeXYchuoi(x,y:byte;chuoi:string;tt:byte);
Begin
gotoxy(x,y);
textattr:=tt;
write(chuoi);
textattr:=old;
End;
Function TaoMenu(x,y,max:byte;tieude:mang):byte;
Var chon : byte;
kt : char;
Begin
For chon:=1 to max do
writexychuoi(x,y+chon,tieude[chon],old);
chon:=1;
Repeat
writexychuoi(x,y+chon,tieude[chon],31);
kt:=readkey;
if kt=#0 then kt:=readkey;
writexychuoi(x,y+chon,tieude[chon],old);
case kt of

#80:if chon<max then inc(chon) else chon:=1;
#72:if chon>1 then dec(chon) else chon:=max;
end;
Until kt=#13;
Taomenu:=chon;
End;
{----------------------------Nhap-------------------------------}
Procedure NHAP;
Var ch,i : byte;
tieude : mang;
Begin
clrscr;
tieude[1]:='1. Nhap bang co che sinh so ngau nhien';
tieude[2]:='2. Nhap tu Ban phim ';
ch:=taomenu(30,8,2,tieude);
clrscr;
case ch of
1:nhapdulieu(a);
2:BanPhim;
end;
clrscr;
Writexychuoi(28,1,'DAY SO BAN DAU',15);
For i:=1 to n do writexyso(i*4-3,3,old,i);
End;
{---------------------------------------------------------------}
Procedure clr;
Var i,j:byte;
Begin
For i:=6 to 16 do {6}
for j:=1 to 100 do write(#32);

End;
Procedure Xoa(x,y:byte);
Begin
gotoxy(x,y-1);write(' '); {1}
gotoxy(x,y);write(' ');
gotoxy(x,y+1);write(' ');
End;
{--------------------------HVi---------------------------------------}
Procedure HVi(var i,j:byte);
Var x,coti,dongi,cotj,dongj : byte;
Begin
coti:=i*4-3;
cotj:=j*4-3;
writexyso(coti,dong,159,i);
writexyso(coti,dong,159,j);
delay(tg);
xoa(coti,dong);
xoa(cotj,dong);
dongi:=dong-3;
dongj:=dong+3;
WriteXYso(coti,dongi,159,i);
WriteXYso(cotj,dongj,159,j);
delay(tg);
While (coti<>j*4-3)or(cotj<>i*4-3) do
begin
xoa(coti,dongi);xoa(cotj,dongj);
if i<j then begin coti:=coti+4;cotj:=cotj-4;end
else begin cotj:=cotj+4;coti:=coti-4;end;
writexyso(coti,dongi,159,i);writexyso(cotj,dongj,159,j);delay(tg);
end;

xoa(coti,dongi);xoa(cotj,dongj);
inc(hv);
gotoxy(1,19);writeln('So lan hoan vi : ',hv);
x:=a[i];a[i]:=a[j];a[j]:=x;
writexyso(i*4-3,dong,old,i);writexyso(j*4-3,dong,old,j);delay(tg);
End;
{--------------------Nho hon--------------------------------------}
Function Nhohon(i,j:byte):boolean;
Begin
Writexyso(i*4-3,dong,207,i); {207}
Writexyso(j*4-3,dong,207,j);
delay(tg);
inc(ss);
gotoxy(1,18);writeln('So lan so sanh :',ss);
NhoHon:=a[i]<a[j];
Writexyso(i*4-3,dong,old,i);Writexyso(j*4-3,dong,old,j);delay(tg);
End;
{------------------Chon truc tiep (Selection Sort)-------------------}
Procedure SelectionSort(var a:m1;n:byte);
Var i,j,min: byte;
Begin
Writexychuoi(28,5,'Chon Truc Tiep (Selection Sort) ',14);{14}
clr;
For i:=1 to n do writexyso(i*4-3,dong,15,i);
For i:=1 to n-1 do
begin
min:=i;
for j:=i+1 to n do
if Nhohon(j,min) then min:=j;
If min<>i then

HVi(min,i);
end;
writexychuoi(24,12,' Day da duoc sap xep xong',14);
gotoxy(24,24);
write('Nhan ENTER de tiep tuc...');
readln;
End;
{------------------------------NHO--------------------------------}
Function nho(x,j:byte):boolean;
Begin
nho:=x<a[j]; {<}
writexyso(j*4-3,dong,207,j);delay(tg);
writexyso(j*4-3,dong,old,j);delay(tg);
inc(ss);
gotoxy(1,18);writeln('So lan so sanh : ',ss);
End;
{---------------------Chen truc tiep (Insertion Sort)--------------}
Procedure Insertionsort (var a:m1;n:byte);
Var i,j,k,x : byte;
thoat : boolean;
Begin
Writexychuoi(28,5,'Chen Truc Tiep (Insertion Sort)',14);
clr;
For i:=1 to n do writexyso(i*4-3,dong,15,i);
For i:=2 to n do
begin
a[n+1]:=a[i];
writexyso(i*4-3,dong,159,i);delay(tg);
xoa(i*4-3,dong);
writexyso(i*4-3,dong-3,159,i);

x:=a[i];
j:=i-1;
thoat:=not(nho(x,j));
while (not thoat)and(j>=1) do
begin
for k:=j*4-3+1 to (j+1)*4-3 do
begin
xoa(k-1,dong);writexyso(k,dong,207,j);delay(tg);
end;
writexyso(k,dong,old,j);delay(tg);
a[j+1]:=a[j];
dec(j);
thoat:=not(nho(x,j));
end;
a[j+1]:=x;
for k:=i downto (j+2) do
begin
xoa(k*4-3,dong-3);delay(tg);
writexyso((k-1)*4-3,dong-3,207,n+1);delay(tg);
end;
xoa((j+1)*4-3,dong-3);delay(tg);
writexyso((j+1)*4-3,dong,old,n+1);delay(tg);
end;
writexyso(n*4-3,dong,old,n);delay(tg);{n}
writexychuoi(24,12,'Day da duoc sap xep xong',14);
gotoxy(24,24);
write('Nhan ENTER de tiep tuc...');
readln;
End;
{----------------------Noi bot (BubbleSort)---------------------------}

Procedure BubleSort(var a:m1;n:byte);
Var i,j,k : byte;
Begin
Writexychuoi(28,5,'Sap xep noi bot (Buble Sort) ',14);
clr;
For i:=1 to n do writexyso(i*4-3,dong,old,i);
For i:=2 to n do
For j:=n downto i do
begin
k:=j-1;
if Nhohon(j,j-1) then HVi(j,k);
end;
writexychuoi(24,12,'Day da duoc sap xep xong',14);
gotoxy(24,24);
write('Nhan ENTER de tiep tuc...');
readln;
End;
{-----------------------Sap xep vun dong(HeapSort)--------------------}
Procedure HeapSort(var a:m1;n:byte);
Var L,R,tam,i : Byte;
procedure Sift(L,R:Byte);
var i,j,x,k,m : byte;
cont : boolean;
begin
i:=L;
cont:=True;
j:=2*i; { j va j+1 la 2 phan tu lien doi voi i }
x:=a[i];
a[n+1]:=x;
m:=i;

writexyso(i*4-3,dong-3,155,i);
While (j<=R) and cont do
begin
writexyso(i*4-3,dong,155,i);delay(tg);
xoa(i*4-3,dong);delay(tg);
if j<R then
begin
k:=j+1;
if NhoHon(j,k) then inc(j);
end; {sau buoc nay a[j] la phan tu lien doi lon nhat}
If not nho(x,j) then
begin
cont:=False;
writexyso(i*4-3,dong,155,i);delay(tg);
writexyso(i*4-3,dong,OLD,i);delay(tg);
end
Else { x <= a[j] }
begin
xoa(j*4-3,dong);
for k:=j downto i do
begin
writexyso(k*4-3,dong+3,207,j);delay(tg);
xoa(k*4-3,dong+3);delay(tg);
end;
writexyso(i*4-3,dong,207,j);delay(tg);
writexyso(i*4-3,dong,old,j);delay(tg);
a[i]:=a[j];
i:=j;
j:=2*i;
end;

if m<>i then
begin
for k:=m+1 to i do
begin
writexyso(k*4-3,dong-3,207,n+1);delay(tg);
xoa(k*4-3,dong-3);delay(tg);
end;
writexyso(i*4-3,dong,207,n+1);delay(tg);
writexyso(i*4-3,dong,old,n+1);delay(tg);
end;
a[i]:=x;
end;
xoa(m*4-3,dong-3);delay(tg);
End;
Begin