USES CRT; CONST MaxLength=50; {do dai danh sach} TYPE Elementtype = Integer; {kieu phan tu trong DS} Position = Integer; {kieu vi tri cac phan tu} List= record {mang chua cac phan tu cua danh sach} Element: Array[1 MaxLength] of Elementtype; Last : Integer; { giu do dai danh sach } End; {------------------------------------------------------------------} Procedure Makenull_List(var L: List); begin L.Last:=0; end; Function Empty_List(L : List ) : Boolean; Begin Empty_List:=(L.Last=0); End; {------------------------------------------------------------------} Procedure Insert_List(X:Elementtype; P:Position; var L: List); Var q:Position; Begin If L.last>=MaxLength Then Writeln('Loi : danh sach day ') Else If (p>L.Last+1) or (p<1) Then Writeln('Loi: vi tri khong hop le ') Else Begin {doi cac phan tu tu vi tri P den cuoi danh sach xuong 1 vi tri } For q:=L.Last Downto p Do L.Element[q+1]:=L.Element[q]; L.Last:=L.Last+1; {do dai tang len 1} L.Element[p]:=X; {dat vao vi tri P} End; End; {-----------------------------------------------------------------------------------------} procedure Delete_List(P:Position ; var L:List); Var q:Position; Begin If (p>L.last) or (p<1) then writeln('Loi : vi tri cua phan tu xoa khong hop le ') Else Begin {doi cac phan tu tu vi tri P+1 den cuoi danh sach len 1 vi tri } For q:=p+1 to L.Last do L.Element[q-1]:=L.Element[q]; L.Last:=L.Last-1; End; End; {-------------------------------------------------------------------------------} Function End_List(L: List) : Position; Begin End_List:=L.Last+1; End; {--------------------------------------------------------------------------------} Function Next(p:Position; L: List) : Position; Begin If (p>L.Last) or (p<1) Then writeln('Khong xac dinh ') Else Next:=p+1; End; {---------------------------------------------------------------------------------} Function Previous (p:Position; L: List) : Position; Begin If (p>L.Last+1) or (p<2) Then writeln('Khong xac dinh ') Else Previous:=p-1; End; {---------------------------------------------------------------------------------} Procedure Read_List(var L:List);{Nhap so lieu cho danh sach} Var i,n:integer; X: ElementType; Begin Makenull_List(L); gotoxy(10,6);Write('Nhap vao so luong phan tu cua mang:');Readln(n); For i:=1 to n do Begin Gotoxy(10,6+i); Write('Nhap phan tu thu ',i,' : '); Readln(X); Insert_List(X,End_List(L),L); end; end; Procedure Read_List1(var L:List;h:word);{Nhap so lieu cho danh sach} Var i,n:integer; X: ElementType; Begin Makenull_List(L); gotoxy(10,h);Write('Nhap vao so luong phan tu cua mang:');Readln(n); For i:=1 to n do Begin Gotoxy(10,h+i); Write('Nhap phan tu thu ',i,' : '); Readln(X); Insert_List(X,End_List(L),L); end; end; {----------------------------------------------------------------------------------} Procedure Print_List(L:List;n:Word);{Xuat danh sach } Var i:integer; Begin if (not Empty_List(L)) then for i:=1 to L.Last do write(L.Element[i]:n) else write('* Danh sach rong'); writeln; End; {-------------------------------------------------------------------------------------------------------------} Procedure KT(L:List;Var n:integer); Var i:integer; Begin i:=1; While (L.Element[i]<=L.Element[i+1])and(i<L.Last) do i:=i+1; n:=i; End; Procedure Insert (L:List;Var L1:List;n:position);{Them mot node vao dau, giua, cuoi danh sach} Var i,y:integer; Begin L1:=L; Case n of 1:Begin Begin Write('Nhap vao gia tri phan tu muon them vao:');Readln(y); Insert_List(y,1,L1); End; End; 2:Begin Write('Nhap vao gia tri phan tu muon them vao:');Readln(y); Insert_List(y,L1.Last+1,L1); End; 3:Begin Write('Nhap vao gia tri phan tu muon them vao:');Readln(y); i:=L1.Last div 2; Insert_List(y,i+1,L1); End; End; End; {------------------------------------------------------------------------------------------------} Procedure Delete (L:List;Var L1:List;P:Word);{Xoa 1 nut o dau, giua, cuoi danh sach} Var i:integer; Begin L1:=L; Case p of 1:Delete_List(1,L1); 2:Delete_List(L1.Last,L1); 3:Begin i:=(L1.Last+1) div 2;Delete_List(i,L1);End; End; End; {------------------------------------------------------------------------------------------------} Procedure Tim(x,y:word;L:List;Var L1:List;h:integer); Var i:integer; Begin MakeNull_List(L1); gotoxy(x,y);Print_List(L,14);Delay(3000); For i:=1 to L.Last do Begin If L.Element[i]<>h then Begin Textcolor(4); gotoxy(x+i*14-2,y); Write('[',L.Element[i],']<>',h,';VT=',i);Delay(5000); Textcolor(7); gotoxy(x+i*14-2,y); Write(' ',L.Element[i],' '); End; If L.Element[i]=h then Begin Textcolor(blue); gotoxy(x+i*14-2,y); Write('[',L.Element[i],']=',h,';VT=',i);Delay(3000); Textcolor(7); Insert_List(i,End_List(L1),L1); gotoxy(x+L1.Last*4,y+2); Write(L1.Element[L1.Last]); gotoxy(x+i*14-2,y); Write(' ',L.Element[i],' '); End; End; If L1.Last=0 then Begin Writeln;Writeln;Writeln;Writeln;Writeln; Writeln('Gia tri ',h,' khong ton tai trong mang'); End; End; {--------------------------------------------------------------------------------------------} Procedure sapxep1(var L1:list;L:List); var i,j,t:integer; Begin L1:=L; for i:=1 to End_List(L1)-2 do for j:=i+1 to End_list(L1)-1 do if L1.element[j]<L1.element[i] then begin t:=L1.element[j]; L1.element[j]:=L1.element[i]; L1.element[i]:=t; end; end; {---------------------------------------------------------------------------------------------} Procedure Giao(L1,L2:list;var L3:list); Var i,k,j,t,h:integer; begin Makenull_List(L3); for i:=1 to End_list(L1)-1 do for j:=1 to End_List(L2)-1 do if L1.element[i]=L2.element[j] then insert_list(L2.element[j],End_List(L3),L3); k:=1; j:=End_List(L3); while k<j-2 do Begin t:=End_List(L3); h:=k; While h<t-1 do if L3.Element[k]=L3.Element[h+1] then Begin Delete_List(h+1,L3); t:=End_List(L3); h:=h; End else h:=h+1; j:=t; k:=k+1; End; End; {---------------------------------------------------------------------------------------} Procedure AHieuB(x,y:Word;L1,L2:List;Var L:List); Var i,j,k,h:Word; Begin gotoxy(x,y);Print_List(L1,8); Gotoxy(x,y+1);Print_List(L2,8); MakeNull_List(L); For i:=1 to L1.Last do Begin gotoxy(x+i*8-2,y); Write('[',L1.Element[i],']');delay(2000); j:=1; While (j<End_List(L2))And(L1.Element[i]<>L2.Element[j]) do Begin gotoxy(x+j*8-2,y+1); Write('[',L2.Element[j],']');delay(1000); gotoxy(x+j*8-2,y+1); Write(' ',L2.Element[j],' '); j:=j+1; End; IF L1.Element[i]=L2.Element[j] then Begin gotoxy(x+j*8-2,y+1); Write('[',L2.Element[j],']');Delay(2000); gotoxy(x+j*8-2,y+1); Write(' ',L2.Element[j],' '); TextColor(4); gotoxy(x+i*8-2,y); Write('[',L1.Element[i],']'); TextColor(7); End; if j= End_List(L2) then Begin TextColor(blue); gotoxy(x+i*8-2,y); Write('[',L1.Element[i],']'); TextColor(7); Insert_List(L1.Element[i],End_List(L),L); gotoxy(x+L.Last*8-2,y+3);Write(L.Element[L.Last]); End; End; End; {-----------------------------------------------------------------------------------} Procedure DoHoaGhep(x,y:Word;L1,L2:List;Var L:List); Var i,h:integer; Begin L:=L1; i:=1; gotoxy(x,y);Print_List(L2,8); Gotoxy(x,y+1);Print_List(L,8); While i<=L2.Last do Begin gotoxy(x+i*8-2,y); Write('[',L2.Element[i],'] ');delay(2000); if i<L1.Last then Begin TextColor(4); gotoxy(x+i*2*8-2,y+1); Write('[',L.Element[i*2],']'); gotoxy(x+(i*2-1)*8-2,y+1); Write('[',L.Element[i*2-1],']');Delay(2000); TextColor(7); gotoxy(x+i*2*8-2,y+1); Write(' ',L.Element[i*2],' '); gotoxy(x+(i*2-1)*8-2,y+1); Write(' ',L.Element[i*2-1],' '); h:=L.Last+1; While h<>i*2 do Begin gotoxy(x+(h-1)*8-1,y+1); Write(L.Element[h-1],'->');Delay(3000); gotoxy(x+h*8-1,y+1); Write(L.Element[h-1],' '); gotoxy(x+(h-1)*8-1,y+1); Write(L.Element[h-1],' ');h:=h-1; End; gotoxy(x+h*8-1,y+1); Write(L2.Element[i],' '); Insert_List(L2.Element[i],2*i,L) End Else Begin gotoxy(x+(L.Last+1)*8-1,y+1); Write(L2.Element[i],' ');Delay (1000); gotoxy(x+i*8-2,y); Write(' '); Insert_List(L2.Element[i],L .Last+1,L); End; i:=i+1; End; End; {-----------------------------------------------------------------------------------} Procedure TextList(L:List); Var i:integer; Begin i:=1; While (L.Element[i]<=L.Element[i+1])and(i<L.Last) do i:=i+1; If i=L.Last then Write('Mang da duoc sap xep') Else Writeln('Mang chua duoc sap xep'); End; {----------------------------------------------------------------------------------} Procedure XPTT(L:List;Var L1:List); Var i,j:integer; Begin L1:=L; i:=1; While i<=L1.Last-1 do Begin j:=i+1; While j<=L1.Last do If L1.Element[i]=L1.Element[j] then Begin Delete_List(j,L1); j:=j; End Else j:=j+1; i:=i+1; End; End; {--------------------------------------------------------------------------------------} {--------------------------------------------------------------------------------------} Procedure SumList(L:List); Var s,i:integer; Begin s:=0; For i:=1 to L.Last do S:=s+L.Element[i]; Writeln('Tong cua mang la:',s); End; {-----------------------------------------------------------------------------------------} Procedure VeND(x,y,n,mc:byte;ch,k:char); Var i:byte; Begin Gotoxy(x,y); textcolor(mc); Case k of 'N':Begin For i:=1 to n do Write(ch:2); End; 'D':Begin For i:=1 to n do Begin Gotoxy(x,y+i); Write(ch); End; End; End; Textcolor(7); End; {-------------------------------------------------------------------------------} Procedure MCTD(x,y,mc,mn:byte;nd:string); Begin Gotoxy(x,y); TextBackground(mn); textcolor(mc); Write(nd); textbackground(0); Textcolor(7); End; {-----------------------------------------------------------------------------------------} Procedure CC(x,y,mc,mn,td:byte;nd:string); Var i:byte; Begin For i:=1 to length(nd) do Begin MCTD(x+i,y,mc,mn,nd[i]); delay(td); End; End; {-----------------------------------------------------------------------------------------} Procedure CG(x,y,mc,mn,t:byte;nd:String);{Chay giua} var st:string; i,j,l,giua,x1,x2:byte; begin st:=nd; l:=length(nd); x1:=x; y:=y; x2:=x1+l-1; giua:=(l+1)div 2; for i:=giua downto 1 do begin for j:=1 to i do begin MCTD(x1+j-1,y,2,7,st[i]); MCTD(x2-j+1,y,2,7,st[l-i+1]); delay(t); MCTD(x1+j-1,y,2,7,' '); MCTD(x2-j+1,y,2,7,' '); end; MCTD(x1+j-1,y,2,0,st[i]); MCTD(x2-j+1,y,2,0,st[l-i+1]); end; end; {------------------------------------------------------------------------------} Procedure DoHoaGiao(x,y:Word;L1,L2:List;Var L:List); Var i,j,k,h:Word; Begin gotoxy(x,y);Print_List(L1,8); Gotoxy(x,y+1);Print_List(L2,8); MakeNull_List(L); h:=1; For i:=1 to L1.Last do Begin gotoxy(x+i*8-2,y); Write('[',L1.Element[i],']');delay(1000); j:=0; Repeat j:=j+1; gotoxy(x+j*8-2,y+1); Write('[',L2.Element[j],']');delay(1000); gotoxy(x+j*8-2,y+1); Write(' ',L2.Element[j],' '); Until (j>=L2.Last)or(L1.Element[i]=L2.Element[j]); k:=1; While (k<=L.Last)and(L1.Element[i]<>L.Element[k])and(L1.Element[i]=L2.Element[j]) do Begin gotoxy(x+k*8-2,y+3); Write('[',L.Element[k],']');delay(1000); gotoxy(x+k*8-2,y+3); Write(' ',L.Element[k],' '); k:=k+1; End; If (L1.Element[i]=L.Element[k]) then Begin Textcolor(4); gotoxy(x+k*8-2,y+3); Write('[',L.Element[k],']');delay(1000); Textcolor(7); gotoxy(x+k*8-2,y+3); Write(' ',L.Element[k],' '); End; IF (K=L.Last+1)and(L1.Element[i]=L2.Element[j])then Begin Textcolor(Blue); gotoxy(x+i*8-2,y); Write('[',L1.Element[i],']'); gotoxy(x+(j)*8-2,y+1); Write('[',L2.Element[j],']');Delay(2500); Textcolor(7); gotoxy(x+(j)*8-2,y+1); Write(' ',L2.Element[j],' '); Insert_List(L1.Element[i],L.Last+1,L); Gotoxy(x+h*8-2,y+3);Write(L.Element[L.Last]); h:=h+1; End Else Begin TextColor(4); gotoxy(x+i*8-2,y); Write('[',L1.Element[i],']');delay(2000); TextColor(7); End; End; End; {------------------------------------------------------------------------------------------------------} Procedure DohoaHop(x,y:Word;L1,L2:List;Var L,L3:List); Var i,j,k:Word; Begin MakeNull_List(L); MakeNull_List(L3); L3:=L2; gotoxy(x,y);Print_List(L1,8); Gotoxy(x,y+1);Print_List(L2,8); k:=1; For i:=1 to L1.Last do Begin gotoxy(x+i*8-2,y); Write('[',L1.Element[i],']');delay(1000); j:=0; Repeat j:=j+1; gotoxy(x+j*8-2,y+1); Write('[',L2.Element[j],']');delay(1000); gotoxy(x+j*8-2,y+1); Write(' ',L2.Element[j],' '); until ((L1.Element[i]=L2.Element[j]))or(j=L2.Last) ; If L1.Element[i]=L2.Element[j] then Begin Textcolor(4); gotoxy(x+(j)*8-2,y+1); Write('[',L2.Element[j],']'); gotoxy(x+i*8-2,y); Write('[',L1.Element[i],']');Delay(3500); Textcolor(7); gotoxy(x+(j)*8-2,y+1); Write(' ',L2.Element[j],' '); End; If (j=L2.Last)and(L1.Element[i]<>L2.Element[L2.Last]) then Begin Textcolor(Blue); gotoxy(x+i*8-2,y); Write('[',L1.Element[i],']');Delay(2500); Textcolor(7); Insert_List(L1.Element[i],L.Last+1,L); Insert_List(L1.Element[i],L3.Last+1,L3); Textcolor(3); Gotoxy(x+(L.Last+L2.Last)*8-2,y+1); Write(L.Element[L.Last]); Textcolor(7); End; End; End; {--------------------------------------------------------------------------------------------------------------} Procedure DoHoaXPTT(x,y:Word;Var L:List); Var i,j,k,h:integer; Begin Gotoxy(x,y); Print_List(L,8); Begin i:=1; While i<L.Last do Begin j:=i+1; gotoxy(x+i*8-2,y); Write('[',L.Element[i],']');delay(1500); While j<=L.Last do Begin gotoxy(x+j*8-2,y); Write('[',L.Element[j],']');delay(1500); if (L.Element[i]=L.Element[j]) then Begin Textcolor(4);