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

Chia sẻ: Thach Anh Anh | Ngày: | Loại File: DOC | Số trang:37

Thêm vào BST

Báo xấu

328
lượt xem 75
download

Download Vui lòng tải xuống để xem tài liệu đầy đủ

TÀI LIỆU THAM KHẢO BÀI TẬP LẬP TRÌNH - DEMO CÁC PHƯƠNG PHÁP SẮP XẾP

Chủ đề:

Bình luận(0) Đăng nhập để gửi bình luận!

Lưu

Nội dung Text: 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 chon1 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 (cotij*4-3)or(cotji*4-3) do begin xoa(coti,dongi);xoa(cotj,dongj); if i
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]
If mini 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
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
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 mi 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
Writexychuoi(28,5,'Sap xep vun dong (Heap Sort) ',14); clr; For i:=1 to n do writexyso(i*4-3,dong,old,i); L:=n div 2; While L>1 do begin Dec(L); Sift(L,n); end; R := n; While R > L do Begin HVi(L,R); Dec(R); Sift(L,R); End; writexychuoi(24,12,'Day da duoc sap xep xong',14); gotoxy(24,24); write('Nhan ENTER de tiep tuc...'); readln; End; {----------------------Sap xep nhanh (Quicksort)------------------------} Procedure QuickSort(var A:m1;Lo,Hi:Integer);
procedure Sort(l,r:Integer); var i,j,x : byte; begin i:=l;j:=r;x:=a[(l+r) div 2]; writexyso(l*4-3,dong,47,l); writexyso(r*4-3,dong,47,r); repeat while a[i]
if i
else setfillstyle(1,7); BAR(1,1,GETMAXX,GETMAXY); setfillstyle(1,9); BAR(6,100,GETMAXX-5,GETMAXY-6); setfillstyle(8,8); BAR(6,100,GETMAXX-410,GETMAXY-6); setfillstyle(8,8); BAR(395,100,GETMAXX-5,GETMAXY-6); setfillstyle(8,3); BAR(6,6,GETMAXX-6,90); Setcolor(9); Rectangle(1,1,GETMAXX-1,GETMAXY-1); Setcolor(14); Rectangle(2,2,GETMAXX-2,GETMAXY-2); Setcolor(1); Rectangle(4,4,GETMAXX-4,GETMAXY-4); Setcolor(4); Rectangle(6,6,GETMAXX-6,GETMAXY-6); SETCOLOR(11); settextstyle(7,0,4); outtextxy(80,18,'TIM HIEU CAC THUAT TOAN'); SETCOLOR(5);
settextstyle(7,0,4); outtextxy(79,17,'TIM HIEU CAC THUAT TOAN'); SETCOLOR(11); settextstyle(7,0,3); outtextxy(180,50,'SAP XEP TREN MANG'); SETCOLOR(5); settextstyle(7,0,3); outtextxy(179,49,'SAP XEP TREN MANG'); k[1]:='Selectsort'; k[2]:='Insertsort'; K[3]:='Bubblesort '; K[4]:='Heapsort'; K[5]:='Quicksort '; k[6]:='Merge sort'; k[7]:='Thoat'; setfillstyle(1,15); for i:=1 to 7 do begin settextstyle(1,0,1); setcolor(10); ellipse(260,135+30*i,0,360,7,7); fillellipse(260,135+30*i,5,5); outtextxy(280,120+30*i,K[i]); end;
for i:=1 to 7 do begin setcolor(i); arc(getmaxx-6,getmaxy,90,9,250-5*i-20); end; setcolor(10); SETLINESTYLE(0,0,13); RECTANGLE(2,95,639,GETMAXY-1); setcolor(9); RECTANGLE(4,98,636,GETMAXY-2); setcolor(13); RECTANGLE(6,100,633,GETMAXY-3); setcolor(10); RECTANGLE(8,102,630,GETMAXY-4); setcolor(123); settextstyle(1,0,1); outtextxy(60,140,'HUONG DAN'); outtextxy(30,160,'Dung 2 phim mui'); outtextxy(30,180,'ten len - xuong'); outtextxy(30,200,'thuc hien chuc nang,'); outtextxy(30,220,'Enter de quyet dinh'); setcolor(123);settextstyle(2,0,6);outtextxy(400,155,'GVHD:');