bafi tap thi hoc sinh gioi chon loc mon tin hoc

Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn Bài Tập Tin học chọn lọc {Bai toan Xep BALO (KNAPSACLE PROBLEM) * Co N hop kim loai trong luong Pi(KG) ,co gia ban la Vi (USD).Mot balo co the mang duoc M KG .Hay xac dinh ti le can lay o moi hop sao cho thu duoc 1 Balo co gia tri nhat. Vi du:Co 3 hop sat 1 2 3 Khoi luong P = 18KG 15KG 10KG Gia ban V = 25USD 24USD 15USD M=20 Ta co nhung cach sap xep sau: 1 2 3 Value P/an 1: 9KG 5KG 6KG 12,5USD 8USD 9 USD 29,5 USD P/an 2: 9KG 10KG 1KG 12,5USD 16USD 1,5USD 30 USD P/an 3: 0KG 15KG 5KG 0USD 24USD 7,5USD 31,5 USD Ta con rat nhieu phuong an de sap xep.Nhung cach xep de co duoc gia tri nhieu nhat la XEP NHUNG HOP KIM LOAI MA GIA TRI CUA 1 KG LA LON NHAT vao truoc GIAI THUAT:Xep lai cac hop Kim loai,Hop nao ma gia tri 1 KG cao nhat thi xep truoc.Sau do bo tung hop vao cho den khi day Tui thi thoi.Ta co the tach KL cua hop ra} Program Bai_toan_BALO; Uses crt; const N=5; type arr=array[1..N]of byte; var P,V,id:arr;{Khoi luong moi hop sat,Gia tri moi hop sat,Giu chi so} M:real;{Khoi luong tui xach} {********************************************************************} Procedure Input; Var i:byte; begin write('Khoi luong tui xach:');readln(M); write('Do vat :');For i:=1 to n do write(i:5); writeln; write('Khoi luong:');for i:=1 to n do begin repeat P[i]:=random(20); until P[i]>0; write(P[i]:5); end; writeln; write('Gia tri :'); for i:=1 to n do begin repeat V[i]:=random(20); until V[i]>0; write(V[i]:5); end; end; {********************************************************************} Procedure sortmax; var i,j,temp:byte; begin for i:=1 to n do id[i]:=i; for i:=1 to n-1 do 1 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn for j:=i+1 to n do if V[id[j]]/P[id[j]]>V[id[i]]/P[id[i]] then begin temp:=id[i]; id[i]:=id[j]; id[j]:=temp; end; end; {********************************************************************} Procedure Output; var i:byte; begin write('Do vat :');For i:=1 to n do write(id[i]:5); writeln; write('Khoi luong:');for i:=1 to n do write(P[id[i]]:5); writeln; write('Gia tri :'); for i:=1 to n do write(V[id[i]]:5); end; {********************************************************************} Procedure Control; var Value,Temp,Cost:real;i:byte; begin i:=1;Value:=0;{Gia tri cua nhung hop duoc xep vao tui} repeat if P[id[i]]>=M then temp:=M else temp:=P[id[i]]; Cost:=(V[id[i]]/P[id[i]])*temp;{Chua gia tri cua hop sat duoc chon de bo vao} writeln('Vat thu ',id[i],' duoc chon:'); write(temp:0:3,'KG ');writeln(cost:0:3,'$ '); value:=value+cost; M:=M-temp; inc(i); until (M=0) or (i=n+1); writeln('Tong gia tri cua cac mat hang duoc chon:',value:0:3,'$'); end; {********************************************************************} Begin clrscr; Randomize; Input; writeln; Sortmax; writeln('Cac do vat sau khi duoc sap xep:'); Output; writeln; Control; readln; end. {Cho mot cai can gom 2 dia can va N qua can co trong luong la A[1],A[2]..A[n] la nhung so nguyen .Hay tim tat ca cac cach dat mot so qua can len dia ben trai va len dia ben phai sao cho can thang bang(Can thang bang khi trong luong tren hai dia can bang nhau GIAI THUAT:Vi du cho 4 qua can voi trong luong la:1 2 1 3 Ta co cac cach xep le hai ben nhu sau: TRAI PHAI 1 1 1 1 1 1 2 1 2 3 2 1 1 3 1 2 + Ta dung phuong phap vet can + Cac bien duoc dung: Luu1:Luu tru nhung trong luong de dat ben trai 2 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn Luu2:Luu tru nhung trong luong de dat ben phai K1:So luong qua can dat ben trai K2:So luong qua can dat ben phai Can1:Luu lai tong khoi luong cua cac qua can duoc chon o ben trai Can2:Luu lai tong khoi luong cua cac qua can duoc chon o ben phai Chon:Danh dau nhung qua can da duoc chon + Khoi tri: K1:=0;K2:=0;Can1:=0;Can2:=0(Chua co qua can nao ben trai va ben phai) Chon[i]:=0;(I=1..N);(Chua co qua can nao duoc chon de dat len) + Tien trinh: Neu (Can1=Can2) va (Can1>0) thi Xuat nhau*) Nguoc lai Xet qua cac qua can J bat dau tu 1 den N + Neu qua can J chua duoc dat len ben nao thi * Neu ben trai nhe hon ben phai thi - Dat qua can do ben trai - Danh dau qua J da duoc chon - Tang so qua can ben trai le va luu lai khoi luong cua no - Tang trong luong cua can ben trai - Xet qua can ke tiep * Neu ben phai nhe hon ben trai thi lam nguoc lai doi voi ben phai * Chu Y:Khi chon duoc 1 cach can thi ta quay lui lai de tim cach can khac} Program bancan; Uses Crt; Const Mn=100; Type Arr=Array[1..MN]of Byte; Var Chon,Qua,Luu1,Luu2:Arr;Soqua:Byte;Can1,Can2:Integer;K1,K2:Byte; {*********************************************************************} Procedure Input; Var J:Byte; Begin Write('Nhap so qua can:');Readln(Soqua); For J:=1 to Soqua do Begin Qua[j]:=Random(5)+1; Write(Qua[j]:4); End; Writeln; K1:=0;K2:=0;Can1:=0;Can2:=0; Fillchar(Chon,Sizeof(Chon),0); End; {*********************************************************************} Procedure Print; Var J:byte; Begin Write('Can ben trai:'); For J:=1 to K1 do Write(Luu1[j]:4); Writeln; Write('Can ben phai:'); For J:=1 to K2 do Write(Luu2[j]:4); Writeln; Write('Trong luong moi ben la:',Can1); Readln; End; {*********************************************************************} Procedure Tim(I:Byte); Var J:Byte; 3 (*Hai ben cua can bang Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn Begin If (Can1=Can2) and (Can1>0) then Print Else For J:=1 to Soqua do If Chon[j]=0 then Case Can1=Trungbinh then Print Else For J:=1 to N do If (Chon[j]=False) and (J>i) then Begin Inc(K); Luu[K]:=J; Sum:=Sum+A[j]; Chon[j]:=True; Tim(J); Dec(K); Chon[j]:=False; Sum:=Sum-A[j]; End; End; {********************************************************************} Procedure Tim1(I:byte); Var J:Byte; Begin If Sum=Trungbinh then Print Else For J:=1 to N do If (Chon[j]=False) and (J>i) then Begin Inc(K); Luu[K]:=J; Sum:=Sum+A[j]; Chon[j]:=True; Tim(J); Dec(K); Chon[j]:=False; Sum:=Sum-A[j]; End; End; {********************************************************************} Begin Clrscr; Randomize; Repeat Input; Writeln; Writeln('Tong=',tong); If (Tong mod (Gap+1))=0 then Begin Dem:=0; Fillchar(Chon,Sizeof(chon),False); K:=0; Sum:=0; Trungbinh:=Tong div (Gap+1); Tim(1); 5 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn End; Until Dem>0; Readln; End. program ma_tran_chuyen_vi; uses crt; const dim=20; type mang=array[1..dim,1..dim] of integer; var a:mang; n:integer; procedure nhap(var a:mang;var n:integer); var i,j:integer; begin write('Kich thuoc ma tran : ');readln(n); for i:=1 to n do for j:=1 to n do a[i,j]:=random(99); end; procedure xuat; var i,j:integer; begin writeln; for i:=1 to n do begin for j:=1 to n do write(a[i,j]:3); writeln; end; end; procedure chuyenvi(var a:mang;n:integer); var i,j,k,tg,m:integer; begin k:=1;m:=n; for i:=1 to n div 2 do begin for j:=k to m-1 do begin tg:=a[i,j]; a[i,j]:=a[j,m]; a[j,m]:=a[m,n-j+1]; a[m,n-j+1]:=a[n-j+1,k]; a[n-j+1,k]:=tg; end; inc(k); dec(m); end; end; begin clrscr; randomize; nhap(a,n); xuat; chuyenvi(a,n); xuat; readln end. {De-so-153:Cho M loai tien voi gia tri tu nhien A1,A2,..,Am va 1 gia tri tien N(tu nhien).Viet thuat toan va chuong trinh de tinh tat cac cach bieu dien N thanh M loai tien ke tren Giai thuat:Quay lui(Back tracking)} Program De154; Uses Crt; Const MN=100; Type Arr=Array[1..MN]of integer; ArrBool=Array[1..MN]of Boolean; Var A,Luu:arr;Tong,N:Integer;M,K:Byte; {***********************************************************************} 6 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn Procedure Input; Var I:Byte; Begin Write('Nhap So loai tien:');Readln(M); Write('Nhap so tien can doi:');Readln(N); For I:=1 to M do Begin A[i]:=Random(10)+1; Write(A[i]:4); End; Writeln; K:=0; Tong:=0; End; {***********************************************************************} Procedure Print; Var J:Byte; Begin For J:=1 to K do Write(Luu[J]:4); Writeln; End; {***********************************************************************} Procedure Tim(I:Byte); Var J:Byte; Begin If Tong=N then Print Else For J:=1 to M do If (Tong+A[j]<=N) and (J>I) then Begin Tong:=Tong+A[j]; Inc(K); Luu[k]:=A[j]; Tim(J); Dec(K); Tong:=Tong-A[j]; End; End; {***********************************************************************} Begin Clrscr; Randomize; Repeat Input; Tim(1); Until False; Readln; End. {De_so_158:O mot dat nuoc co N thanh pho.Giua cac thanh pho co cac tuyen duong (1 chieu).Biet rang: 1) Giua hai thanh pho bat ky co the di den nhau (co the qua nhieu tuyen duong). 2) Tu 1 thanh pho so cac duong di ra bang so cac duong di vao. Lap thuat toan tim mot con duong xuat phat tu 1 thanh pho nao do ,di qua tat ca cac tuyen duong ,moi tuyen duong 1 lan ,cuoi cung tro ve thanh pho ban dau GIAI THUAT:Quay lui} Program De_so_158; uses crt; const n=5; type so=0..1; arr=array[1..n,1..n]of so; arr1=array[1..n]of byte; arr2=array[1..n]of boolean; 7 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn var A:arr;{Quan he cua Thanh pho I voi J} TD:arr1;{Luu tru thanh pho da di qua} Ok:arr2;{Kiem tra thnh pho da duoc di qua} K:byte; dem:byte;{So duong di} {**********************************************************************} Procedure Nhap; var i,j:byte; begin for i:=1 to n do for j:=i to n do if i=j then a[i,j]:=0 else begin a[i,j]:=random(2); a[j,i]:=a[i,j]; end; for i:=1 to n do begin for j:=1 to n do write(a[i,j]:4); writeln; end; end; {**********************************************************************} Procedure Print; var j:byte; begin if A[TD[n],Td[1]]=1 then {Kiem tra thanh pho cuoi cung voi thanh pho dau tien di qua co duong di voi nhau khong} begin inc(dem);{Tang so duong di} for j:=1 to n do write(Td[j]:4); writeln(Td[1]:4); end; end; {**********************************************************************} Procedure Truyhoi(i:byte); var j:byte; begin if k=n then print else for j:=1 to n do if (a[i,j]=1) and Ok[j] then {Dieu kien de di tu TP I de TP J la hai thanh pho phai thong nhau Va thanh pho J chua di qua} begin Inc(k); TD[k]:=j;{luu tru thanh pho duoc di qua} Ok[j]:=false;{Thanh pho J da di qua} truyhoi(j);{Xet thanh pho J voi thanh pho chua duoc chon} dec(k); Ok[j]:=true;{Xoa bo viec ghi thanh Tp J da duoc di qua} end; end; {**********************************************************************} Begin clrscr; randomize; repeat clrscr; nhap; 8 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn dem:=0; fillchar(Ok,sizeof(ok),true); Ok[2]:=false;k:=1; Td[1]:=2;{Xuat phat tu thanh pho thu 2} writeln('Cac cach di:'); truyhoi(2); if dem=0 then writeln('Khong co cach di nao') else writeln('Co ',dem,' cach di'); until dem>0; readln; end. {Co N nguoi va N cong viec.Goi Cij la cong suc lam viec j cua nguoi i.Lap chuong trinh de sap xep moi nguoi 1 cong viec sao cho cong suc bo ra la it nhat THUAT TOAN: Vet can tat ca cac truong hop xay ra .Chon truong hop toi uu} Program baitoan_congviec; Uses crt; Const mn=7; Type arr=array[1..mn,1..mn] of word; arr1=array[1..mn] of word; arrbol=array[1..mn] of boolean; Var C:arr;{Cong suc lam viec} A:arr1;{Chua cong viec duoc chon khi xet tung truong hop} B:arr1;{Luu lai ket qua cong viec duoc chon tam thoi} j,n:byte; Tong:word;{Chua tong cac cong viec cua tung buoc chon} min:word;{Giu gia tri de tim ra TONG cac cong viec nho nhat} Chon:arrbol;{keim tra xem Cong Viec do duoc chon hay chua} {***************************************************************************} Procedure nhap; Var i,j:byte; Begin n:=mn; for i:=1 to n do Begin for j:=1 to n do Begin c[i,j]:=random(10)+1; write(c[i,j]:4); End; writeln; End; End; {***************************************************************************} Procedure Output; Var J:byte; Begin If tong2) or (tong2>2) then exit; end; end; 12 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn Ok:=true; end; {************************************************************************} Procedure Print; var j:byte; begin inc(dem); writeln('Cach chon thu ',dem,':'); write('Nam:');for j:=1 to n do write(j:2);writeln; write('Nu :');for j:=1 to n do write(nguoi[j]:2);readln; end; {************************************************************************} Procedure Timketiep(i:byte); var j:byte; begin if i>n then print else for j:=1 to n do if (dance[j]=false) and (A[i,j]=1) then begin nguoi[i]:=j;{Ghi lai Nguoi Nu j duoc nguoi nam i moi nhay} dance[j]:=true;{Danh dau nguoi Nu thu j da duoc moi nhay} timketiep(i+1);{Xet nguoi Nam ke tiep} dance[j]:=false;{Xoa bo viec danh dau,Nguoi Nu thu j khong duoc chon} end; end; {************************************************************************} begin clrscr; readfile; writeln; dem:=0; fillchar(dance,sizeof(dance),false); timketiep(1);{bat dau tu nguoi Nam thu 1} readln; end. {De 239:Cho hai so tu nhien a,b.Ta noi rang a nam trong b neu nhu khai trien nhi phan cua a co the thu duoc tu khai trien nhi phan cau b bang cach xoa di 1 so chu so. Lap thuat toan cho phep tu hai so cho truoc m,n tim so tu nhien d lon nhat sao cho d nam trong ca m va n GIAI THUAT:Viet 1 ham doi ra nhi phan(nguoc) cua 1 so Viet ham OK kiem tra so a co nam trong so b khong Cho d chay tu N xuong M .Kiem tra dong thoi d co nam trong M va N khong} Program De_so_239; uses crt; const so:array[0..1]of char=('0','1'); var m,n,d:word; {**************************************************************} Function Nhiphan(a:word):string;{Doi ra nhi phan cua 1 so} var st:string; begin st:=''; repeat st:=st+so[a mod 2]; a:=a div 2; until a=0; nhiphan:=st; end; 13 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn {**************************************************************} Function Ok(st1,st2:string):boolean;{Kiem tra nhi phan cua so nay co the thu duoc bang cach bo di 1 so chu so cua nhi phan cua so kia hay khong} var i:byte; begin ok:=false; {So sanh tung so cua St1 voi St2.Neu co so do trong St2 thi xoa so giong no trong St2} for i:=1 to length(st1) do if pos(st1[i],st2)<>0 then delete(st2,pos(st1[i],st2),1) else exit; Ok:=true; end; {**************************************************************} Procedure Process; begin writeln('M:',nhiphan(m)); writeln('N:',nhiphan(n)); for d:=n downto m do begin if ok(nhiphan(d),nhiphan(m)) and ok(nhiphan(d),nhiphan(n)) then begin writeln('So D lon nhat nam trong ca M va N la:'); writeln('D:',d); writeln(nhiphan(d)); exit; end; end; writeln('Khong co so D nao nam trong ca M va N'); end; {**************************************************************} begin clrscr; write('Nhap M:');readln(m); write('Nhap N:');readln(N); Process; readln; end. {De_so_254:Bai toan "Ca Heo": Loai ca heo chi chuyen dong theo 3 huong:Tu vi tri (X,Y) no chi co the chuyen dich duoc den vi tri (X+1,Y) hoac (X,Y+1) hoac (X-1,Y-1).Gia su vi tri ban dau cua ca heo la o trai duoi cua luoi o vuong NxN Lap thuat toan cho biet ca heo co the di khap ban co ,moi o 1 lan hay khong? Neu duoc ,chi ra lo trinh cua ca heo GIAI THUAT:Ca heo chi chuyen dong duoc ve 1 trong 3 huong: Tu (X,Y) --> (U,V) =>U=X+1;V:=Y+0; Tu (X,Y) --> (U,V) =>U=X+0;V:=Y+1; Tu (X,Y) --> (U,V) =>U=X-1;V:=Y-1; + Dung ma tran A de chua danh dau cot ,dong da di qua:A[Dong,Cot]=1 Va chua di qua A[Dong,Cot]=0; + Dung Mang Luu de luu tru Dong va Cot vua di qua Chuong trinh Neu qua du N*N (K= N*N) o cua ban co thi In ra Cach di Nguoc lai: For J:=1 den 3 lam + U:=X+A1[j]; + V:=Y+B1[j]; + Neu U ,V nam trong ban co thi: 14 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn + Luu giu lai U,V + Danh dau Dong V ,Cot V da di qua :A[U,V]:=1; + Xet O(U,V) voi cac o con lai + Neu khong tim duoc duong di hay da tim 1 con duong di,Quay lai de tim duong khac} Program Baitoan_Caheo; Uses Crt; Const Mn=100; A1:array[1..3] of Integer=(1,0,-1); B1:array[1..3] Of Integer=(0,1,-1); Type Vitri=record X,Y:Byte; End; So=0..1; Arr=Array[1..MN,1..MN] Of So; Arr1=Array[1..MN]of Vitri; Var A:arr;Luu:Arr1;K,N,Cot,Dong:Byte; Th:set of Byte; {*******************************************************************} Procedure Input; Var I:Byte; Begin Write('Nhap N:');Readln(N); Fillchar(A,Sizeof(A),0); Write('Nhap Dong:');Readln(Dong); Write('Nhap Cot:');Readln(Cot); K:=1; Luu[k].x:=Dong; Luu[k].y:=Cot; A[Dong,Cot]:=1; Th:=[]; For i:=1 to N do Th:=Th+[I]; End; {*******************************************************************} Procedure Print; Var I:Byte; Begin Clrscr; Write(#7); For I:=1 to K do With luu[I] do Begin Gotoxy(Y*3,X+1); Write('*'); Readln; End; Readln; End; {*******************************************************************} Procedure Try(X,Y:byte); Var U,V,J:Byte; Begin If K=sqr(N) then Print Else For J:=1 to 3 do Begin U:=X+A1[j];V:=Y+B1[j]; If (U in Th) and (V in th) then If A[u,v]=0 then Begin A[u,v]:=1; Inc(k); 15 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn Luu[k].x:=U; Luu[k].y:=V; Try(U,V); Dec(K); A[u,v]:=0; End; End; End; Begin Clrscr; Writeln('BAI TOAN CA HEO'); Input; Try(Dong,Cot); End. {Tren 1 duong vong (khep kin) co n thanh pho xep theo thu tu la A1,A2,..,An. Xuat phat tu 1 thanh pho nao do, mot o to goi la "di mot vong" neu no tu thanh pho da cho di theo duong tren ,qua tat ca cac thanh pho theo mot huong nhat dinh va cuoi cung tro lai thanh pho ban dau. GIAI THUAT :Xet tung thanh pho.Gia su xuat phat tu 1 thanh pho Ai nao do Xem luong xang du tru voi luong xang phai di tu Tp Ai de Ai+1 co du hay thieu>neu thieu thi xet thanh pho ke tiep} Program DE_so_285; uses crt; const n=4; type arr=array[1..n] of integer; var X:arr;{So xang du tru} P,id:arr;{So xang hao khi di giua hai TP} i,j,k:byte; q:boolean;{Kiem tra dieu kien de thoat:Khi xuat phat tu thanh pho nao do ma co the di het duoc qua tat ca cac thanh pho con lai} Xangdu:integer;{Tinh luong xang con du khi chay giua hai thanh pho} {****************************************************************} Procedure Nhap; var i:byte;tong1,tong2:word; begin repeat tong1:=0;tong2:=0; for i:=1 to n do begin write('So xang du tru o TP ',i,':');readln(X[i]); tong1:=tong1+X[i]; if i',i+1,':');readln(P[i]); end; if i=n then begin write('So xang ton khi di tu TP ',i,' ->',1,':');readln(P[i]); end; tong2:=tong2+P[i]; end; if tong1<>tong2 then writeln('Nhap lai:'); until tong1=tong2; end; {****************************************************************} Begin clrscr; Nhap; i:=0; repeat 16 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn inc(i);{Kiem tra thanh pho Ai} q:=false; xangdu:=X[i]-P[i];{Luong xang} k:=1;j:=i;{bat dau xet tu thanh pho Ai tro di} {Dieu kien xet tiep la Luong xang du>0 nghia la xang du tru phia nhieu hon xang su dung khi di va so thanh pho chua xet het} while (xangdu>0) and (k<=n) do begin inc(j); if j=n+1 then j:=1;{Neu qua thanh pho cuoi cung thi quay tro ve thanh pho dau tien} xangdu:=xangdu+P[j]-X[j]; inc(k); end; if k>n then q:=true; until (i=n) or q; if q then writeln('Xuat phat tu Tp ',i); readln; end. {De_so_299:Cho N do vat voi trong luong P1,P2,..,Pn .Hay chia N do vat tren thanh hai khoi sao cho tong khoi luong cac do vat cua hai khoi la xap xi nhau nhat(nghia la hieu hai kkhoi luong la nho nhat. GIAI THUAT:Tim tong khoi luong cua N do vat =>Trung binh cua hai khoi. Sap xep do vat tang dan theo khoi luongffff Tim nhung do vat co tong khoi luong gan voi Trung binh nhat} Program De299; Uses Crt; Const MN=100; Type Arr=Array[1..Mn]of integer; Var P,L,A:arr;N,K,K1,I:Byte;Tong,TB,Sum,Min,Kl:Integer; Chon,Chon2:array[1..Mn]of boolean;Q:Boolean; {*********************************************************************} Procedure Input; Var I:Byte; Begin Write('Nhap N:');Readln(N); Tong:=0; For I:=1 to N do Begin P[i]:=Random(9)+1; Write(P[i]:4); Tong:=Tong+P[i]; End; Writeln; Writeln('Tong khoi luong cua ',n,' do vat la:',Tong); TB:=Tong div 2;{Trung binh trung binh cua 1 khoi} Fillchar(chon,sizeof(chon),False); End; {*********************************************************************} Procedure Sort(Var A:arr;N:byte); Var I,J:byte;Temp:Integer; Begin For I:=1 to N-1 do For J:=I+1 to N do If P[i]>P[j] then Begin Temp:=A[i]; A[i]:=A[j]; A[j]:=Temp; End; End; 17 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn {*********************************************************************} Procedure Test; Var J:Byte; Begin Min:=Abs(Tb-Sum); KL:=Sum; K1:=K; For J:=1 to K do L[j]:=A[j]; For J:=1 to N do Chon2[j]:=Chon[j]; If Min=0 then Q:=True End; Procedure Try(I:Byte); Var J:Byte; Begin If (Abs(TB-Sum)N then Print else For j:=1 to 2 do Begin D[i]:=Dau[j]; Case j of 1:Tong:=Tong+A[i]; 2:Tong:=Tong-A[i]; end; Truyhoi(i+1); Case j of 1:Tong:=Tong-A[i]; 2:Tong:=Tong+A[i]; end; End; End; {******************************************************************} Begin clrscr; Randomize; repeat clrscr; Sl:=0; For i:=1 to n do Begin A[i]:=random(20); write(A[i]:4); End; writeln; Tong:=0; Truyhoi(1); Until Sl>0; Readln; End. {De_so_39:Bai toan "DOI MAU BI":Tren ban co N1 hon bi xanh,N2 hon bi do,N3 hon bi vang.Luat choi nhu sau:Neu 2 hon bi khac mau nhau cham nhau thi chung se cung ben thanh mau thu 3. (Vi Du:xanh,vang --->do,do) Tim thuat toan va lap chuong trinh cho biet rang co the bien tat ca cac hon bi do thanh 1 mau do duoc khong GIAI THUAT:Trong 2 loai bi mau Xanh va mau Vang.Chon loai bi co so luong nhieu hon.Lay bi co so luong nhieu hon ,cham voi bi do. Luc nay Bi co so luong it hon se tang SL len 2 don vi.So luong bi nhieu hon giam di 1 don vi + Neu so luong bi it hon ma tang len bang so luong bi nhieu hon 19 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn thi luc nay ta co the bien doi ve tat ca deu bi DO + Neu Bi co so luong it hon sau 1 thoi gian tang ma lon hon Bi co so luong nhieu hon HAY So luong bi do khong du de cho cham tiep thi ta khong the bien doi ve tat ca deu bi DO} Program De_so_39; Uses crt; var N1,N2,N3:word; Begin clrscr; Write('Nhap so luong bi Bi XANH:');readln(N1); Write('Nhap so luong bi Bi DO:');readln(N2); Write('Nhap so luong bi Bi VANG:');readln(N3); writeln('XANH DO VANG'); writeln(n1:4,n2:4,n3:4); if N1<>N3 then If N1>N3 then while (N1>N3) and (N2>0) do {So luong bi xanh lon hon so luong bi vang va so luong bi do lon hon 0} {Luc nay Bi xanh se cham bi Do} begin n2:=n2-1;{Bot di so luong bi do} N1:=N1-1;{Bot di so luong bi xanh} N3:=N3+2;{Tang so luong bi xanh len 2 do 2 bi kia cham nhau} writeln(n1:4,n2:4,n3:4); end else while (N10) do {So luong bi xanh lon hon so luong bi vang va so luong bi do lon hon 0} {Luc nay Bi Vang se cham bi Do} begin n2:=n2-1;{Bo so luong bi do} N1:=N1+2;{Tang so luong bi xanh len 2 } N3:=N3-1;{Giam so luong bi vang} writeln(n1:4,n2:4,n3:4); end; if n1=n3 then begin while n1>0 do begin n1:=n1-1; n3:=n3-1; n2:=n2+2; writeln(n1:4,n2:4,n3:4); end; writeln('Ta co the bien tat cac bi thanh mau DO'); end else writeln('Ta khong the bien tat cac bi thanh mau DO'); readln; end. {De_so_404:Mot lop hoc co MxN cho ngoi gom M hang ghe,moi ghe co N hoc sinh .De chuan bi cho ky thi hoc sinh gioi tin hoc ,mot so can su tin hoc moi nguo sang tac mot de sau do sao thanh 1 so ban dua cho nguoi ben canh(Trai,phai, ban truoc,ban sau moi nguoi dung 1 ban ;so nguoi nay co the la 2,3,4 tuy theo vi tri nguoi dua).Sau do tat ca moi nguoi thong bao so de minh Da nhan duoc .Lap chuong trinh xac dinh vi tri cua nhung nguoi trong ban can su .Luu y rang co the co nhieu loi giai .Trong bang la 1 vi du voi M=N=6 Input Output 20 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn 0 1 0 0 0 1 mot 1 0 - - - - - 1 1 1 + + + 0 2 1 0 + 1 0 0 2 1 1 0 2 1 0 2 0 + GIAI THUAT:Doi voi M va N nhap vao ta se tao ra thanh 1 ma tran M+1*N+1 Gan cho moi vi tri deu la 1.Ta xet tung vi tri Neu mot vi tri ma xung quanh no cac vi tri deu 1 0 0 3 2 0 0 0 1 co gia tri >0 thi vi tri do la vi tri cua nguoi can su. Sau do bot gia tri cua nhung vi tri xung quanh vi tri can su lop 1 don vi} Program DE_so_404; Uses crt; Const maxm=20;maxn=30; Type Arr=array[0..maxm,0..maxn]of byte; Arrchar=array[1..maxm,1..maxn]of char; Var A:arr;M,N:byte;B:arrchar; {**************************************************************************} Procedure Nhap; Var I,J:byte; Begin Fillchar(A,sizeof(a),1); Writeln('Input:'); For I:=1 to M do Begin For J:=1 to N do begin A[i,j]:=Random(5); write(A[i,j]:4); end; writeln; end; End; {**************************************************************************} Function Ok(a,b,c,d:byte):Boolean; Begin If (a>0) and (b>0) and (c>0) and (d>0) then Ok:=true else Ok:=false; End; {**************************************************************************} Procedure Xuly; Var I,J:byte; Begin For I:=1 to M do For J:=1 to N do If OK(A[i-1,j],A[i,j-1],A[i,j+1],A[i+1,j]) then Begin B[i,j]:='+'; A[i-1,j]:=A[i-1,j]-1; A[i,j-1]:=A[i,j-1]-1; A[i,j+1]:=A[i,j+1]-1; A[i+1,j]:=A[i+1,j]-1; End Else B[i,j]:='-'; end; {**************************************************************************} Procedure Output; Var I,j:byte; Begin Writeln('Output:'); 21 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn For I:=1 to M do Begin For J:=1 to N do write(B[i,j]:4); writeln; end; Writeln('Chu thich:Can su(+)'); End; {**************************************************************************} Begin clrscr; Randomize; N:=6;M:=6; Nhap; Xuly; Output; readln; end. {De_so_408:Cho hai cap so nguyen duong (A1,B1),(A2,B2).Hay kiem tra xem hinh chu nhat S1 co canh (A1,B1) co the nam trong hinh chu nhat S2 canh (A2,B2) duoc khong. GIAI THUAT:+ Dieu kien can la: Dien tich S2>Dien tich S1 + Dieu kien du la:Canh lon nhat cua S1 phai nho hon canh lon nhat cua S2. Canh nho nhat cua S1 phai nho hon canh nho nhat cua S2.} Program DE_so_408; Uses crt; Var A1,B1,A2,B2:word; {*********************************************************************} Procedure Input; Begin Repeat A1:=random(25); B1:=random(25); A2:=random(25); B2:=random(25); Until (A1>0) and (B1>0) and (A2>0) and (B2>0); Gotoxy(30,1);Writeln('Hinh chu nhat thu 1:'); Gotoxy(30,2);Writeln(' A1 B1'); Gotoxy(30,3);Writeln(A1:5,B1:5); Gotoxy(30,4);Writeln('Hinh chu nhat thu 2:'); Gotoxy(30,5);Writeln(' A2 B2'); Gotoxy(30,6);Writeln(A2:5,B2:5); End; {*********************************************************************} Procedure Ve(a,b:word;j:byte); Var I:Word; Begin For I:=J to A do Begin Gotoxy(I,J);write('*'); Gotoxy(I,B);write('*'); End; For I:=J to B do Begin Gotoxy(J,I);write('*'); Gotoxy(A+J-1,I);write('*'); End; End; {*********************************************************************} Function Dientich(a,b:word):word; Begin Dientich:=A*B; End; {*********************************************************************} Function Max(A,B:word):word; 22 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn Begin If A>B then Max:=A else Max:=B; End; {*********************************************************************} Function Min(A,B:word):word; Begin If ADientich(A1,B1) then If (Max(A1,B1)0) and (A[i,j] in Th); write(A[i,j]:4); Th:=Th-[A[i,j]]; end; writeln; end; end; {*****************************************************************} Function Ok(a,b,c,d:byte):boolean; begin If (aN then Print else For KTC:='0' to '1' do If (ST[i-1]='1') or ((St[i-1]='0') and (KTC<>'0')) then Begin ST:=ST+KTC; Truyhoi(I+1); Delete(st,I,1); End; end; begin clrscr; N:=10; Solan:=0; St:='1'; Truyhoi(2); St:='0'; Truyhoi(2); Writeln('Co tat ca ',solan,' xau nhi phan "Gon" co do dai la ',n); readln; end. {De_so_423:Lap chuong trinh in ra tat ca cac day nhi phan "Gon" ,do dai N va chua dung M so 1 25 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn GIAI THUAT:Vet can ,Kiem tra dieu kien de chon : + Khong co hai so nao la 0 lien nhau + Co dung m chu so 1} Program De_so_423; Uses crt; Var St:string; N:Byte;{Chieu dai xau} M:Byte;{So chu so 1 co trong xau} SL:Word;{Dem so luong xau nhi phan thoa man de bai} M1:Byte;{Dem so luong ky tu 1 co trong xau } {*****************************************************************} Procedure Print; Var I:byte; Begin If M1=M then {Neu so ky tu 1 trong chuoi bang M thi Xuat} Begin For i:=1 to N do write(St[i]); Inc(Sl); if (Sl mod 20)=0 then readln; writeln; End; End; {*****************************************************************} Procedure Truyhoi(I:byte); Var KT:Char; Begin If (I>N) then Print else For Kt:='0' to '1' do If (ST[i-1]='1') or ((ST[i-1]='0') and (KT<>'0')) then Begin If KT='1' then M1:=M1+1;{Neu ky tu duoc chon la 1 thi so luong chu so 1 trong chuoi duoc tang len} ST:=ST+KT; Truyhoi(I+1); If St[I]='1' then M1:=M1-1;{Neu ky tu moi them vao la 1 khi xoa bo thi so luong Ky tu 1 trong chuoi se giam di 1} Delete(St,i,1); {Xoa bo ky tu mo them vao} End; end; {*****************************************************************} Begin Clrscr; Write('Nhap N:');readln(N); Repeat Write('Nhap M:');readln(M); Until MN then Print else For KT:='0' to '1' do If (ST[I-1]<>'0') or (Kt='1') or (ST[i-1]='0') and (K1N div 2-1 thi So cach bieu dien cua (*) hon so cach bieu dien (**) 1 cach Neu M<=N div 2-1 thi so cach bieu dien cua (*) bang so cach bieu dien (**)} Program De_so_425; Uses Crt; Var N,M,Tong,Giatri,Max,Sl:word; Luu:array[1..100]of word; K:byte;Q:boolean; {********************************************************************} Procedure Print; Var J:byte; Begin Case Q of True:If K=M then {Truong hop 1} Begin For J:=1 to K do write(Luu[j],'+'); Gotoxy(wherex-1,wherey);write('='); Inc(Sl); End; False:If K>1 then {Truong hop 2} Begin For J:=1 to K do write(Luu[j],'+'); Gotoxy(wherex-1,wherey);write('='); Inc(Sl); End; End; End; {********************************************************************} Procedure Tim(I:byte); Label Find; Var J:word; Begin If Tong=Giatri then Print Else For J:=1 to Max do If (J+Tong<=giatri) and (j>=i) then Begin Tong:=Tong+J; Inc(K); Luu[k]:=J; Tim(j); Dec(K); Tong:=Tong-J; End; End; {********************************************************************} Begin Clrscr; Write('Nhap N:');readln(N); Write('Nhap M:');Readln(M); {Truong hop 1:} Tong:=0;{Tong ban dau} Q:=true;{Truong hop 1} 28 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn Sl:=0;{So cach bieu dien} K:=0;Giatri:=N;Max:=N; Write(N,'='); Tim(1); Gotoxy(wherex-1,wherey);writeln(' '); Writeln(#7,'Co ',sl,' cach');Readln; {Truong hop 2:} Tong:=0; Q:=false; Sl:=0; K:=0;Max:=M;Giatri:=N-M; write(n,'-',m,'='); Tim(1); Gotoxy(wherex-1,wherey);writeln(' '); Writeln(#7,'Co ',sl,' cach');Readln; Readln; End. {De_so_439:Cho truoc n so tu nhien A1,A2,..,An.Tim ra so cuc dai K sao cho tap tren co the chia thanh K nhom co tong nhu nhau. GIAI THUAT: Buoc 1:Tim tong tat ca cac so A1,A2,..,An TONG:=A1+A2+..+An Buoc 2:Xet K tu N tro xuong den 2 (Vi it nhat la 2 nhom va nhieu nhat la N nhom) K:N-->2; Neu TONG chia cho K (nhom) la 1 so nguyen thi: Mot nhom se co tong so la: TONG1NHOM=TONG div K; Buoc 3:Tim nhung so co tong = TONG1NHOM Neu ta chia N so duoc K nhom thi khong xet tiep nua} Program De_so_439; Uses Crt; Const Mn=100; Type Arr=array[1..MN]of integer; Var A:arr;N:byte; {******************************************************************} Procedure Input; Var I:byte; Begin Write('N:');Readln(N); For I:=1 to N do Begin A[i]:=Random(9)+1; Write(A[i]:4); End; End; {******************************************************************} Procedure Xuly; Var I,K,Sl,Slchon:Byte;Tong,Ketqua,Tong1nhom:integer;Q:Boolean; Chon,B:array[1..mn]of byte; {Chon:Kiem tra so duoc chon chua;B:Luu lai so duoc chon cho 1 nhom} Procedure Timtong(I:byte); Var J,K:byte; Begin If Ketqua=Tong1nhom then Begin Sl:=Sl+Slchon;{Tang so luong so A duoc chon} For K:=1 to Slchon do Chon[B[k]]:=2;{Danh dau nhung so da duoc chon vao 1 nhom} End Else For J:=1 to N do 29 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn If (Chon[j]=0) and (A[j]+Ketqua<=Tong1nhom) then Begin Chon[j]:=1;{Danh dau Aj da duoc chon} Inc(slchon);{Tang so luong so cua Nhom} B[slchon]:=j;{Luu tru Aj duoc chon} Ketqua:=Ketqua+A[j];{Tang tong cac so cua nhom} Timtong(j);{Tim so ke tiep} Ketqua:=Ketqua-A[j]; Dec(Slchon); if Chon[j]=1 then Chon[j]:=0; End; End; Begin Tong:=0; For I:=1 to N do Tong:=Tong+A[i];{Tinh tong cac so} K:=N+1; Q:=False; Repeat Dec(K); If (Tong mod K)=0 then {Neu Tong chia K duoc 1 so nguyen} Begin Tong1nhom:=Tong div K;{Trung binh 1 nhom} Sl:=0;Ketqua:=0;Slchon:=0; fillchar(chon,sizeof(chon),0); Timtong(1); If Sl=N then Q:=True; End; Until Q or (K=2); Writeln; If Q then Begin Writeln('K=',k); Writeln('Tong moi nhom la:',tong1nhom); End Else Writeln('Khong chia duoc'); End; {******************************************************************} Begin Clrscr; Randomize; Repeat Clrscr; Input; Xuly; Readln; Until False; End. {Xet tap cac xau nhi phan do dai N ,tren do xet cac phep bien doi sau:Lay ra mot xau con do dai K (2<=K<=N cho truoc) va doi nguoc lai thu tu cua xau con nay. 1/Nhap vao tu ban phim hai xau S1,S2 do dai N.Kiem tra tinh dung dan cua du lieu. 2/Kiem tra xem tu xau S1 sau huu han cac phep bien doi tren co the thu duoc xau S2 khong .Neu duoc leit ke len man hinh lan luot cac phep bien doi do. Khi do ta goi hai xau nay la tuong duong 3/Toi uu hoa cau (2) theo nghia so phep bien doi la it nhat. 4/In ra tap hop lon nhat cac xau nhi phan khong tuong duong voi do dai N GIAI THUAT:Hai xau nhi phan khong tuong duong khi so luong chu so 1 va so luong chu so 0 cua hai xau khong bang nhau. 3/Ta chia Xau 2 thanh nhieu xau con voi chieu dai lan luot la 30 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn N,N-1,N-2,...,2 Vi Du: S2=0110 Ta chia thanh: 1/ 2/ 3/ 4/ 5/ 6/ Luc do xau 1 ta cung chia theo vi tri va chieu dai vay Vi du: S1=1010 Ta chia thanh: 1/ 2/ 3/ 4/ 5/ 6/ 1010 101 10 010 01 10 0110 011 01 110 11 10 nhu Ta so sanh tung xau con cau S1 voi xau con tuong ung voi no cua S2 Neu hai xau doi xung nhau(Vi du 01 ,10) thi ta doi nguoc lai xau con do cua S1.neu truong hop hai xau S1, S2 khong co hai xau con doi xung nhau thi ta cho doi ngau nhien 1 doan cua xau con S1. Lap di cho den khi S1=S2; 4/Tap hop cac xau nhi phan co do dai N ma khong tuong duong la nhung xau co so luong chu so 1 khac nhau} Program De_so_442; Uses Crt; Const Doi:array[0..1] of char=('0','1'); N=5; Var S1,S2,St:String;L,K:byte; {*********************************************************************} Procedure Input(Var St:string); Var I:byte; Begin St:=''; Repeat I:=Random(2); Write(I); St:=ST+doi[i]; Until length(St)=N; Writeln; End; {*********************************************************************} {Kiem tra so luong chu so 1 cua 2 xau co bang nhau khong ?} Function Ktra(S1,S2:string):Boolean; Var SL_1:Integer;I:byte; Begin Sl_1:=0; For I:=1 to length(s1) do If S1[i]='1' then Sl_1:=Sl_1+1; For I:=1 to length(S2) do If S2[i]='1' then Sl_1:=Sl_1-1; If Sl_1=0 then Ktra:=True Else Ktra:=False; End; {*********************************************************************} {Kiem tra hai xau co doi xung nhau khong} Function Palindom(st1,st2:string):boolean; Var I:byte; Begin Palindom:=False; If St1<>St2 then Begin For I:=1 to length(st1) do If St1[I]<>St2[Length(st1)-I+1] then Exit; End 31 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn Else exit; Palindom:=True; End; {*********************************************************************} {Dao 1 xua tu vi tri A den vi tri B} Procedure Dao(Var S:string;A,B:byte); Var I,J,K,L:Byte;Temp:Char; Begin J:=A;I:=B; While J'); Repeat Q:=true; For I:=1 to N-1 do For J:=N downto I do Begin St1:=Copy(S1,I,J-I+1);{Cat xau con trong xau S1} St2:=Copy(S2,I,J-I+1);{Cat xau con trong xau S2} If Palindom(St1,St2) then Begin Dao(s1,i,j); If S1<>S2 then Write(s1,'->'); Delay(200); Q:=false;{Co su dao} End; If S1=S2 then Exit;{Neu hai xau nhu nhau thi thoat} End; If Q then {Neu xau khong dao thi dao ngau nhien} Begin Repeat K:=random(n-1)+1; J:=Random(n)+1 Until J>K; Dao(s1,K,J); If S1<>S2 then write(#7,s1,'->'); End; Until S1=S2; End; {*********************************************************************} Begin Clrscr; Randomize; Input(s1);Input(S2); Xuly; 32 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn Writeln(s2); Readln; Writeln('Tap hop lon nhat cac xau nhi phan khong tuong duong:'); For K:=0 to N do Begin ST:=''; For L:=1 to K do St:=St+'1'; For L:=K+1 to N do St:=ST+'0'; writeln(st); End; Readln; End. {Cho K hop diem xep thanh hinh tron .So N1,N2,..,Nk ghi tren moi hop la so diem trong moi hop .Cho phep chuyen mot so luong diem bat ky (nho hon hoac bang so diem tai thoi diem hien thoi ) sang hop ke no (trai hoac phai). Yeu cau:Chuyen so diem giua cac hop sao cho trong moi hop diem co so luong nhu nhau Neu duoc: 1/Hay neu mot phuong an chuyen. 2/Tim phuong an chuyen sao cho tong so diem phai chuyen la it nhat 3/Neu khong:bo sung mot so it nhat hop diem rong de co the thuc hien duoc yeu cau tren. GIAI THUAT: De thuc hien duoc viec chuyen so diem giau cac hop sao cho trong moi hop diem deu co so luong nhu nhau thi Tong so diem trong tat ca cac hopphai chia deu co so hop diem va khong co du que diem nao ca.Do do neu khong thuc hien duoc thi ta phai them so luong hop diem rong cho den khi tong so diem chia cho so hop khong du + Ta thuc hien cach chuyen tu trai sang phai. Neu so luong diem cua Trai nhieu hon Trung binh(So diem cho moi hop) thi chuyen so diem du sang hop diem ben canh. Neu den hop diem cuoi cung thi chuyen ve hop diem dau} Program De_so_489; Uses CRt; Const MN=1000; Type Arr=Array[1..mn]of integer; Var N:arr;K:byte;Tong:integer; {********************************************************************} Procedure Input; Var I:byte; Begin Tong:=0; Write('Nhap K:');readln(K); For I:=1 to K do Begin N[i]:=Random(20); Tong:=Tong+N[i]; Write(N[i]:4); End; Writeln; End; {********************************************************************} Function Sonto(a:integer):boolean; Var I:Integer; Begin Sonto:=False; For I:=2 to A-1 do If (A mod I)=0 then Exit; Sonto:=True; End; {********************************************************************} 33 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn Procedure Output; Var J:byte; Begin For J:=1 to K do Write(N[j]:4); Delay(200);Writeln; End; {********************************************************************} Function OK(N:arr;Trungbinh:Integer):Boolean; Var J:byte; Begin OK:=False; For J:=1 to K do If N[j]<>Trungbinh Then Exit; Ok:=True; End; {********************************************************************} Procedure Xuly; Var J:Byte;Trungbinh:Integer; Begin While (Tong mod K)<>0 Do Begin Inc(K);N[k]:=0;End; Trungbinh:=Tong div K; J:=0; Repeat Inc(J); If J=K then If N[j]>Trungbinh then Begin N[1]:=N[1]+N[j]Trungbinh; N[J]:=Trungbinh; J:=1; Output; End; If (JTrungbinh Then Begin N[j+1]:=N[j+1]+N[j]-Trungbinh; N[j]:=Trungbinh; Output; End; Until Ok(N,trungbinh); End; {********************************************************************} Begin Clrscr; Randomize; Repeat Input; If Sonto(Tong) then Begin Writeln('So luong hop diem rong them vao la :',tong-K); Writeln('So cach chuyen rat nhieu,Nhan Enter de thoat');Readln; Halt; End; Xuly; Readln; Clrscr; Until False; End. {De_so_99:Bai toan "Thuy Chien": 34 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn 1 luoi o vuong NxN,1 nguoi danh dau len do (mot cach bi mat) mot so chien" dang 1xK.cac tau chien nay phai roi nhau.Nguoi thu hai "tha bom" o vuong va sau mot lan danh bom thu duoc cau tra loi:" trung" "truot". Tim thuat toan toi uu cho nguoi thu hai de xac dinh duoc vi tri tau GIAI THUAT:Luu tru trong 1 ma tran B voi cac gia tri la 1,Ban dau do tung buoc .Neu ban trung vao tau nghia la xung quanh no khong con con tau nao khac, Xung quanh vi tri cua Con tau bi danh trung ta chuyen thanh 0.Nghia la loai bo nhung vi tri khong can ban} Program DE_so_99; Uses crt; const mn=15; type arr=array[0..mn,0..mn]of byte; Var A,B:arr; n,i,j,k:byte; {**********************************************************} Function Ok(a,b,c,d,e,f,g,h:byte):boolean; {Kiem tra dieu kien xung quanh co tau hay chua} Begin if (a=0) and (b=0) and (c=0) and (e=0) and (d=0) and (f=0) and (g=0) and (h=0) then Ok:=true else Ok:=false; end; {**********************************************************} Procedure Nhap; var i,j:byte; begin n:=4; for i:=1 to n do for j:=1 to n do begin A[i,j]:=random(2); {Neu xung quanh da co tau thi khong dat tau o do} if Ok(a[i-1,j-1],a[i-1,j],a[i-1,j+1],a[i,j-1],a[i,j+1],a[i+1,j1],a[i+1,j],a[i+1,j+1])=false then a[i,j]:=0 end; end; {**********************************************************} Begin randomize; clrscr; fillchar(a,sizeof(a),0); fillchar(b,sizeof(b),1); Nhap; for i:=1 to n do for j:=1 to n do if B[i,j]=1 then begin writeln(i:4,j:4); if A[i,j]=1 then begin writeln('TRUNG'); {Gan gia tri cho cac o xung quanh} B[i-1,j-1]:=0;b[i-1,j]:=0;b[i-1,j+1]:=0;b[i,j1]:=0; b[i,j+1]:=0;b[i+1,j1]:=0;b[i+1,j]:=0;b[i+1,j+1]:=0; end else writeln('Truot'); end; writeln; {Xuat vi tri ban dau cua con tau} for i:=1 to n do begin for j:=1 to n do write(a[i,j]:4); 35 Tren "tau tung hoac Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn writeln; end; readln; end. {Mot duong di goi la "Don Lien" la duong di qua tat ca cac canh cua do thi ma khong co canh nao di qua 2 lan GIAI THUAT: + Luu tru du lieu tren file PATH.DAT + Doc File vao Ma tran A + Tinh so cach cua Do thi. + Dung 1 Ma tran B de danh dau canh da di qua Vi du:B[i,j]=1 nghia la da di qua cach I,J + Duong thu tuc De qui Duong(I:Byte) de quay lui va tim duong di} Program Path; Uses Crt; Const Mn=100; Type THSo=0..1; Arr=Array[0..MN,0..MN]of THso; Arr1=Array[1..MN]Of Byte; Var A,B:arr;N:Byte;Scanh,K:Byte;Luu:Arr1;Dem:word; {***********************************************************************} Procedure Readfile(Fn:string); Var F:Text;I,J:Byte; Begin Assign(F,Fn); {$I-} Reset(F); {$I+} If Ioresult<>0 then Halt; Readln(F,N); If N<1 then N:=1; If N>Mn then N:=MN; Fillchar(A,Sizeof(A),0); Fillchar(B,Sizeof(B),0); Scanh:=0; For I:=1 to N-1 do Begin For J:=I+1 to N do Begin Read(F,A[I,J]); If A[i,j]=1 then Inc(Scanh); A[j,i]:=A[i,j]; End; Readln(F); End; K:=0; Close(F); End; {***********************************************************************} Procedure Out; Var I,J:Byte; Begin For I:=1 to N do Begin For J:=1 to N do Write(A[i,j]:4); Writeln; End; End; {***********************************************************************} Procedure Print; Var J:byte; 36 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn Begin Inc(dem); If (dem mod 9)=0 then readln; Write('Duong di thu ',dem,':'); For J:=1 to K do write(Luu[j]:4); Writeln; End; {***********************************************************************} Procedure Duong(I:Byte); Var J:Byte; Begin If K=Scanh then Print {Neu di qua het cac canh thi xuat ra man hinh duong di} Else For J:=1 to N do If (A[i,j]=1) and (B[i,j]=0) or (I=0) then {Neu tu I den J co duong di va chua di qua cnh IJ} Begin Inc(K); Luu[k]:=j;{Luu tru dinh vua di qua} B[i,j]:=1;{Danh dau Da di qua cach IJ hay JI} B[j,i]:=1; Duong(J);{Xet dinh J voi cac canh tiep} Dec(K); {Quay lai tim duong di khac} B[i,j]:=0; B[j,i]:=0; End; End; {***********************************************************************} Begin Clrscr; Readfile('a:\data\path.dat'); Writeln('Ma tran A ban dau:'); Out; Dem:=0; Window(1,15,80,25); Duong(0); Readln; End. {Trong he toa do vuong goc cho toa do n hon dao la N1(X1,Y1),N2(X2,Y2),... Nn(Xn,Yn).Voi gia thiet rang tat ca cac thung chua cua ca no chi du chua 1 so 1 xang de di quang duong dai khong qua Mkm cho truoc.Trn moi dao deu co xang du trun de Cano co the nap day cac thung chua.Hay tim moi duong di co the cua Cano xuat phat tu dao N(Xi,Yi) den dao Nj(Xj,Yj) va chi ra mot duong di toi uu (co solan ghe vao dao de lay xang la it nhat THUAT TOAN:Quay Lui-Vet can} Program Duong_di; uses crt; const mn=100; type toado=record {toa do dao} x,y:byte; end; arr=array[1..mn]of toado; arr1=array[1..mn]of byte; arrbool=array[1..mn]of boolean; var Dao:arr;{Toa do tung dao} n:byte;{So dao} start,finish:byte;{Dao xuat phat,Dao muon den} k,min:byte;{So dao duoc chon,So dao it nhat duoc di qua} dem:word;{Dem so cach di} M:real;{Do dai quang duong toi da di khong phai do xang} giu,b:arr1;{Giu lai nhung dao da di qua} chon:arrbool;{kiem tra xem tung dao xem co di qua chua} {*********************************************************************} Procedure Nhap; 37 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn var i:byte; begin write('Nhap so dao:');readln(n); for i:=1 to n do with dao[i] do begin {write('X:');readln(x); write('Y:');readln(y); } x:=random(10); y:=random(10); write(x, ' ');writeln(y); end; write('Nhap do dai quang duong M:');readln(M); write('Dao xuat phat:');readln(start); write('Dao ket thuc:');readln(finish); end; {*********************************************************************} Function dodai(a,b:toado):real;{Tinh do dai giua hai dao} begin dodai:=sqrt(sqr(a.x-b.x)+sqr(a.y-b.y)); end; {*********************************************************************} Procedure tim(i:byte); var j,l:byte; begin if (i=finish) then {Neu da di den dao dich} begin for l:=1 to k do write(giu[l]:3); dem:=dem+1;{Dem so cach} if k0 then begin writeln('Co tat ca ', dem,' cach di'); writeln('Duong di toi uu qua it dao nhat la:'); for k:=1 to min do write(b[k]:3); end else writeln('Khong co duong di'); readln; end. Program eightqueen; uses crt; var vitri:array[1..8]of byte; a:array[1..8]of boolean; c:array[2..16]of boolean; b:array[-7..7]of boolean; procedure vehop; var i,j:byte; begin for i:=1 to 8 do begin for j:=1 to 8 do write('*'); writeln; end; end; procedure xuat; var j:byte; begin vehop; for j:=1 to 8 do begin gotoxy(vitri[j],j);write('H'); end; gotoxy(1,9); write('Press Enter to continue');readln; clrscr; end; procedure tim(i:byte); var j:byte; begin if i>8 then xuat else for j:=1 to 8 do if a[j] and b[i-j] and c[i+j] then begin vitri[i]:=j;{Giu lai vi tri con hau} a[j]:=false; b[i-j]:=false; c[i+j]:=false; tim(i+1); {Xoa bo viec ghi nhan con hau} a[j]:=true; b[i-j]:=true; c[i+j]:=true; end; end; begin{Chuong trinh chinh} clrscr; fillchar(a,sizeof(a),true); fillchar(b,sizeof(b),true); 39 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn fillchar(c,sizeof(c),true); tim(1); readln; end. {DE_so_60:Ta biet rang cach nhan tay hai so tu nhien duoc the hien qua vi du sau: 2 1 2 x 3 4 6 _______________ 1 2 7 2 + 8 4 8 6 3 6 _______________ 7 3 3 5 2 } Program De_so_460; Uses crt; Const So:Array['0'..'9'] of byte=(0,1,2,3,4,5,6,7,8,9); Chu:Array[0..9] of char=('0','1','2','3','4','5','6','7','8','9'); Var Number1,Number2,Number3:String;Ch:char; {**********************************************************************} Procedure Input(Var Number:String); Var CH:char;I:byte; Begin Number:=''; Repeat Ch:=readkey; If CH<>#13 then If (Ch in['0'..'9']) then Begin Number:=Number+ch;write(ch); End else halt; Until Ch=#13; Writeln; End; {**********************************************************************} Procedure Output(number:string); Begin Gotoxy(80-length(Number),wherey);writeln(Number); End; {**********************************************************************} Procedure BackSt(Var Number:String); Var I,J:byte;Temp:char; Begin I:=1;J:=Length(Number); While ILength(Number2) then Maxlength:=Length(Number1) 40 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn Else Maxlength:=Length(Number2); End; {**********************************************************************} Function Change(Num:Char):Char; Begin If Num=' ' then Change:='0' else Change:=Num; End; {**********************************************************************} Procedure AddBlank(Var Number1,Number2:string;Max:Byte); Begin While Length(Number1)=10 then Begin Tong:=Tong-10; Memo:=1; End Else Memo:=0; Number3:=Number3+Chu[Tong]; End; If Memo=1 then begin inc(I);Number3[I]:='1';End; Backst(Number3); End; {**********************************************************************} Procedure Nhan(Number1,Number2:String;Var Number3:String); Var I,J,K:byte;Memo,Tich:Byte;Num,Number:String; Begin Number:=''; Backst(Number1); Backst(Number2); For I:=1 to Length(Number2) do Begin Memo:=0; Num:=''; For J:=1 to Length(Number1) do Begin Tich:=(So[Number2[i]]*so[Number1[j]])+memo; If Tich>=10 then Begin Memo:=Tich div 10; Tich:=Tich mod 10; End else Memo:=0; Num:=Num+chu[Tich]; End; If memo<>0 then Num:=Num+chu[memo]; Backst(Num); K:=1; While Ksonguoi then i:=1;{Dem qua nguoi cuoi cung thi tro ve dau} 42 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn If chon[i]=false then inc(m);{Neu chua nhay thi dem} End; If m=n then begin Chon[i]:=true;{Dem du N thi nhay} {writeln('Nguoi thu ',i,' nhay');} nhay(i*3); number:=number+1;{tang so nguoi da nhay} end; Until Number=songuoi-1;{den kh so nguoi con lai la 1} End; Procedure cau2; Begin ghe:=5;N:=1; Repeat{xet Tung N neu N nao thoa thi thoat} clrscr; cau1(n); if chon[ghe]=false then begin Gotoxy(1,2);writeln('N=',n);exit;end; Inc(N); Until False; End; Begin clrscr;n:=7; Cau1(n); I:=0; Repeat Inc(i); if Chon[I]=false then Begin Gotoxy(1,24);Writeln('Nguoi con lai cuoi cung la so ',i); End; Until chon[i]=false; Readln; cau2; Gotoxy(1,24);Writeln('Voi N=',n,' nguoi thu ',ghe,' se con lai tren may bay'); readln; End. {Co N bai hat co chieu dai lan luot la A1,A2,..,An phut da ghi san tren bang va da trong 1 may phat nhac tu dong .Biet rang de phat bai thu K may phai quay bang tu dau v abo qua K-1 bai truoc do.Thoi gian quay de tim cung bang thoi gan quay de phat nhac. Tinh trung binh trong 1ngay cac bai hat deu duoc chon xap xi nhau.Hay xac dinh cach bo tri cac bai hat de tong so thoi gian phat la nho nhat.Neu gia thiet rang moi bai duoc goi dung 1 lan trong ngay. Vi du:Ta co 4 Bai hat: Bai 1 2 3 4 Thoi Luong 9 7 12 1 Cach phat: Cach 1: 1: 9 = 9 2: 9 + 7 = 16 3: 9 + 7 + 12 = 28 4: 9 + 7 + 12 + 1 = 29 ---------------------------------Tong thoi luong= 82 Cach 2: 4: 1 = 1 2: 1 + 7 = 8 1: 1 + 7 + 9 = 17 3: 1 + 7 + 9 + 12 = 29 ---------------------------------Tong thoi luong=55 Vay qua do ta xep cac cuon bang co thoi luong it nhat ve dau} 43 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn Program bangnhac; Uses crt; Const n=10; Type mang=array[1..n] of integer; Var Time:integer;i,j:byte; A,ID:mang; {************************************************************************} Procedure Sapxep(var a,id:mang); Var i,j:byte;temp:integer; Begin for i:=1 to n do Id[i]:=i; for i:=1 to n-1 do for j:=i+1 to n do if a[id[i]]>a[id[j]] then Begin Temp:=Id[i]; Id[i]:=Id[j]; Id[j]:=Temp; End; End; {************************************************************************} Begin clrscr; randomize; for i:=1 to n do a[i]:=random(100); writeln('Thu tu cuon bang ban dau:'); for i:=1 to n do write(i:3);writeln; for i:=1 to n do write(a[i]:3);writeln; Sapxep(a,id); writeln('Thu tu cuon bang sap xep lai la:'); for i:=1 to n do write(id[i]:3);writeln; for i:=1 to n do write(a[id[i]]:3); writeln; time:=0; for i:=1 to n do begin write(Id[i],':'); time:=time+A[id[i]]; for j:=1 to i do write(a[id[j]],'+'); gotoxy(wherex-1,wherey);clreol; writeln('=',time); end; writeln('Tong thoi luong:',time); readln; end. {Yeu cau:Nhap so N va day So1,So2,...,Son.Nhap M . thay the cac dau + - * / vao dau vao giua So1,So2,..,Son.De ket qua cua chung bang M.Neu khong co thong bao ra man hinh + Du Lieu: const Dau:array[1..4] of char=('+','-','*','/'); dung de chua cac dau var so:array[1..mn] of integer; chua cac so a:array[1..mn] of integer; tinh gia tri sau khi thay dau giua cac so + Giai thuat: Dua vao phuong phap vet can.Vet tat cac cac truong hop co the xay ra} Program bt; Uses crt; Const mn=100; dau:array[1..4] of char=('+','-','*','/'); Type arr=array[1..mn] of integer; arrchar=array[1..mn] of char; var so,a:arr;d:arrchar;m,n,i:integer;solan:longint; 44 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn {*****************************************************************} procedure nhap; var i:byte; begin randomize; write('Nhap n:');readln(n); for i:=1 to n do begin repeat so[i]:=random(10); until so[i]>0; write(so[i]:3); if ((i mod 10)=0) or (i=n) then writeln; end; end; {*****************************************************************} procedure print; var j:byte; begin for j:=1 to n-1 do write('('); write(so[1],d[1],so[2],')'); for j:=2 to n-1 do begin write(d[j],so[j+1],')'); end; writeln('=',m); end; {*****************************************************************} procedure truyhoi(i:byte); var j:byte; begin if i=n then begin if a[i]=m then begin print;inc(solan);end; end else for j:=1 to 4 do begin d[i]:=dau[j]; case dau[j] of '+':a[i+1]:=a[i]+so[i+1]; '-':a[i+1]:=a[i]-so[i+1]; '*':a[i+1]:=a[i]*so[i+1]; '/':a[i+1]:=a[i] div so[i+1]; end; truyhoi(i+1); end; end; {*****************************************************************} begin clrscr; repeat clrscr; write('M=');readln(m); nhap; a[1]:=so[1]; solan:=0; truyhoi(1); if solan=0 then writeln(#7,'Khong the thay dau duoc') else writeln('Co tat ca ',solan,' cach thay dau '); Gotoxy(1,25);Write('Press ESC to Exit, any keys to Continue'); until readkey=#27; end. 45 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn program tinh_ma_tran; uses crt; const dim=20; type mang=array[1..dim,1..dim] of integer; var a,b:mang; m,n:integer; procedure create(var a:mang;var m,n:integer); var i,j:integer; begin write('Nhap so dong : ');readln(m); write('Nhap so cot : ');readln(n); for i:=1 to m do for j:=1 to n do a[i,j]:=random(99); end; procedure xuat(arr:mang); var i,j:integer; begin writeln; for i:=1 to m do begin for j:=1 to n do write(arr[i,j]:3); writeln; end; end; procedure maxmin(a:mang;var b:mang); var i,j,x,y:integer; begin for i:=1 to m do begin x:=a[i,1]; y:=a[i,1]; for j:=1 to n do begin if xa[i,j] then y:=a[i,j]; end; for j:=1 to n do begin if a[i,j]=x then b[i,j]:=x; if a[i,j]=y then b[i,j]:=y; if (a[i,j]<>x) and (a[i,j]<>y) then b[i,j]:=0; end; end; end; begin clrscr; randomize; create(a,m,n); xuat(a); maxmin(a,b); xuat(b); readln end. {Cho N nguoi,moi nguoi quen voi it hon N-1 nguoi con lai.Sap xep N nguoi len 1 ban tron sao cho 2 nguoi ngoi canh nhau phai quen nhau THUAT TOAN: + DULIEU:Quan he giua nguoi I va J la Nguoi[i,j]; Neu I quen J thi Nguoi[i,j]:=1 nguoc lai Nguoi[i,j]:=0; + Dua tren phuong phap vet can,quay lui. Chon 1 nguoi dau lam moc.Tim nguoi quen voi nguoi do Cu the cho den khi den nguoi thu N,neu chua duoc phai quay lui lai.Den nguoi thu N kiem tra nguoi Thu N co quen voi nguoi dau tien lam moc hay khong} Program Quen_biet; 46 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn Uses crt; Const mn=50; Type arr=array[1..mn,1..mn]of 0..1; arrbol=array[1..mn] of boolean; arrint=array[1..mn] of byte; Var Nguoi:arr;{Quan he giua nguoi} Chon:arrbol;{Danh dau nguoi da duoc chon de sap len ban tron} N:byte;{So nguoi} A:arrint;{Luu lai so nguoi duoc chon} K:byte; Dem:word;{So cach sap xep} {************************************************************************} Procedure Nhap; Var i,j:byte; Begin for i:=1 to n do for j:=i to n do if j=i then nguoi[i,j]:=0 else begin nguoi[i,j]:=random(2); nguoi[j,i]:=nguoi[i,j]; end; End; {************************************************************************} Procedure show; Var i,j:byte; Begin For i:=1 to n do Begin for j:=1 to n do write(nguoi[i,j]:4); writeln; End; End; {************************************************************************} Procedure print; Var j:byte; Begin if nguoi[a[n],a[1]]=1 then {Keim tra nguoi xep cuoi cung voi nguoi dau tien co quen nhau khong} Begin a[n+1]:=a[1]; Inc(dem); write('Cach xep thu ',dem,':'); For J:=1 to n+1 do write(a[j]:3); writeln; If (dem mod 10)=0 then begin readln; clrscr; show; write('Press Enter to continue'); readln; end; End; end; {************************************************************************} Procedure truyhoi(i:byte); Var j:byte; begin If k=n then print Else for j:=1 to n do if (chon[j]=false) and (nguoi[i,j]=1) then {Dieu kien de chon:Nguoi I phai quen nguoi J va nguoi I khac nguoi J} 47 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn begin Chon[j]:=true;{Nguoi J duoc xep len ban} Inc(k); A[k]:=j;{Luu lai nguoi duoc chon} truyhoi(j);{xet nguoi duoc chon voi nhung nguoi con lai} Chon[j]:=false;{Xoa bo viec chon nguoi thu J} Dec(k); end; end; {************************************************************************} Begin clrscr; randomize; n:=10; repeat clrscr; Nhap; Show; Fillchar(chon,sizeof(chon),false); k:=0; dem:=0; truyhoi(1); if dem=0 then writeln('Khong the sap xep duoc') else writeln('Co tat ca ',dem,' cach xep '); Until dem>0; readln; end. program diem_yen_ngua; uses crt; const dim=30; type mang=array[1..dim,1..dim] of integer; var a:mang; m,n:integer; procedure create(var a:mang;var m,n:integer); var i,j:integer; begin write('Nhap so dong : ');readln(m); write('Nhap so cot : ');readln(n); for i:=1 to m do for j:=1 to n do a[i,j]:=random(40); end; procedure xuat(a:mang); var i,j:integer; begin writeln; for i:=1 to m do begin for j:=1 to n do write(a[i,j]:3); writeln; end; end; procedure maxmin; var i,j,max,min,k,tg:integer; begin writeln; for i:=1 to m do begin max:=a[i,1]; min:=a[i,1]; for j:=1 to n do begin if maxa[i,j] then min:=a[i,j]; 48 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn end; for j:=1 to n do begin if max=a[i,j] then begin tg:=a[i,j]; for k:=1 to m do if tg>a[k,j] then tg:=a[k,j]; if tg=a[i,j] then write(tg:3); end; if min=a[i,j] then begin tg:=a[i,j]; for k:=1 to m do if tg 3 5 7 9 7 8 4 8 9 GIAI THUAT:Chuyen ma tran ban dau ve mang 1 chieu.Sap xep mang do tang dan. Nhan xet: + Ma tran co dung 2*N-1 duong cheo Xet K=2 to 2*N (Duong cheo thu K) I=1 to N do J=1 to N do If (I+J)=K thi (Tang L If K le thi A[i,j]:=B[l] If K chan thi A[i,j]:=B[l]} Program Baitapziczac; Uses Crt; Const Mn=100; Type Arr=Array[1..MN,1..MN]of Integer; Arr1=Array[1..MN*MN]of Integer; Var A:arr;N:Byte;B:arr1; {***********************************************************************} Procedure Input; Var I,J:Byte; Begin Write('Nhap N:');Readln(N); For I:=1 to N do For J:=1 to N do A[i,j]:=Random(100); End; {***********************************************************************} { Chuyen ma tran A ve mang 1 chieu B } Procedure Chuyen; 49 Mét sè bµi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn Var I,J:Byte; Begin For I:=1 to N do For J:=1 to N do B[(I-1)*N+J]:=A[i,j]; End; {***********************************************************************} { Sap xep mang B tang dan } Procedure Sort; Var I,J:Byte;Temp:Integer; Begin For I:=1 to N*N-1 do For J:=I+1 to N*N do If B[i]>B[j] then Begin Temp:=B[i]; B[i]:=B[j]; B[j]:=Temp; End; End; {***********************************************************************} { Xuat ma tran } Procedure Output; Var I,J:Byte; Begin For I:=1 to N do Begin For J:=1 to N do write(A[i,j]:4); Writeln; End; End; {***********************************************************************} { Dua gia tri mang B ve lai cho ma tran theo duong ZicZac } Procedure Xuly; Var I,J,K,L:Byte; Begin L:=0; Chuyen;sort; For K:=2 to 2*N do For I:=1 to N do For J:=1 to N do If (I+J=K) then Begin Inc(L); If Odd(K) then A[I,J]:=B[L] Else A[j,i]:=B[l]; End; End; {***********************************************************************} Begin Clrscr; Randomize; Input; Writeln('Ma tran A ban dau:'); Output; Readln; Xuly; Writeln('Ma tran A sau khi sap xep tang dan theo duong ZicZac:'); Output; Readln; End. 50