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); [...]... setbkcolor(1); cleardevice; settextstyle(6,0,2); setcolor(15); outtextxy(160,40,'Day la kieu sap xep MERGE SORT'); settextstyle(0,0,0); for i:= 1 to n do begin tamy[i]:=340; tamx[i]:=38+(i-1)*62; tron(tamx[i],tamy[i],c[i]); end; delay(1000); Merge_Sort(1,n); setcolor(15); outtextxy(100,450,'Mang da duoc sap xep, an Enter de ve menu chinh !'); Readln; End; (*==========================================================... dai:=y2-y1; y1:=y2+5; y2:=y1+dai; setcolor(15); settextstyle(4,0,2); outtextxy(180,420,'Mot so phuong phap sap xep. '); settextstyle(0,0,0); end; y2:=y2-n*(dai+5); y1:=y1-n*(dai+5); menu(x1,round(y1),x2,round(y2),nd[chonm],h,mnr,mcr); setcolor(15); settextstyle(4,0,2); outtextxy(180,420,'Mot so phuong phap sap xep. '); settextstyle(0,0,0); while ch1 #13 do begin ch1:=readkey; if ch1=#27 then begin cleardevice;... menu(x1,y1+(chonm-1)*(dai+5),x2,y2+(chonm-1)*(dai+5),nd[chonm],h,mnr,mcr); setcolor(15); settextstyle(4,0,2); outtextxy(180,420,'Mot so phuong phap sap xep. '); settextstyle(0,0,0); chon:=chonm; end; end; end; ok:= true; setcolor(15); settextstyle(4,0,2); outtextxy(180,420,'Mot so phuong phap sap xep. '); settextstyle(0,0,0); end; (*========================================================== ====*) procedure H_hop(x1,y1,x2,y2:integer;h:integer;mn,mc:integer);... qs1(l,i-1); qs1(i+1,r); end; setcolor(1); outtextxy(150,450,'An phim bat ky de tiep tuc, Esc de thoat !'); end; Begin for k:=1 to n do b[k]:=a[k]; qs1(1,n); setcolor(15); outtextxy(100,450,'Mang da duoc sap xep, an Enter de ve menu chinh !'); textcolor(1); readln; End; (*========================================================== ====*) (* program heap_sort; USES CRT,GRAPH; CONST R1=16;R2=16; TYPE POINT=RECORD... then exit else xoa(tamx[1],tamy[1],x[1]); tron(62-35,400,x[1]); end; Begin for i:=1 to n do Item[i]:=a[i]; setbkcolor(1); cleardevice; settextstyle(6,0,2); setcolor(15); outtextxy(160,20,'Day la kieu sap xep HEAP SORT'); settextstyle(0,0,0); setcolor(14); outtextxy(150,450,'An phim bat ky de tiep tuc, Esc de thoat !'); tamx[1]:=400;tamy[1]:=90; for i:=2 to 3 do begin tamx[i]:=i*220-140; tamy[i]:=150;... tron(tamx[i],tamy[i],Item[i]); ch:=readkey; if ch=#27 then exit else begin Heap_sort(Item, n); 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; End; (*========================================================== =====*) Procedure Mergesort; Procedure Merge_Sort(l,r:integer); Var t,i,j,k,m:integer; . setcolor(15); outtextxy(90,120,'CAI DAT MOT SO THUAT TOAN '); outtextxy(257,160,&apos ;SAP XEP& apos;); settextstyle(0,0,0); setcolor(12); outtextxy(140,220,'---------------------o0o----------------------');. program Cac_ Thuat_ Toan_ SX; uses crt,graph; const nmax=20; type mang= array[1 nmax] of integer;