# bafi tap thi hoc sinh gioi chon loc mon tin hoc

Document Sample

```					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<Can2 Of True:Begin Chon[j]:=1; Inc(K1);Luu1[k1]:=Qua[j]; Can1:=Can1+Qua[j]; Tim(J); Chon[j]:=0; Dec(K1); Can1:=Can1-Qua[j]; End; False:Begin Chon[j]:=1; Inc(K2);Luu2[k2]:=Qua[j]; Can2:=Can2+Qua[j]; Tim(J); Chon[j]:=0; Dec(K2); Can2:=Can2-Qua[j]; End; End; End; {*********************************************************************} Begin Clrscr;Randomize; Input; Tim(0); Readln; End. {(Chai mang ty le 1:k);Tim cach chia A[1..N] cho truoc thanh hai doan co tong cac phan tu trong doan nay gap k lan tong cac phan tu trong doan kia ,K nguyen duong GIAI THUAT:Tim tong cua toan bo cac phan tu Neu tong chia het cho K+1 phan thi + Tinh gia tri cua phan 1:TB=Tong div (K+1); + Tim nhung so trong day co tong la TB} Program baitap3; Uses Crt; Const Mn=100; Type Arr=Array[1..MN]of integer; Arrbool=Array[1..MN]of Boolean; Var A,Luu:arr;N,K,Dem,Gap:Byte;Sum,Tong,Trungbinh:Integer;Chon:Arrbool; {********************************************************************} Procedure Input; Var I:Byte; Begin Write('Nhap N:');Readln(N); Write('Nhap K:');Readln(Gap); Tong:=0; For I:=1 to N do Begin A[i]:=random(10); Write(A[i]:4); Tong:=Tong+A[i]; End; End; {********************************************************************} Procedure Print; Var J:Byte; Begin 4

Mét sè bµi to¸n Tin häc chän läc

NguyÔn §×nh ChiÕn

If Sum=Trungbinh then Begin For J:=1 to K do Write(Luu[j]:4);Write(' '); For J:=1 to N do If Chon[j]=False then Write(j:4);Writeln; For J:=1 to K do Write(A[Luu[j]]:4);Write(' '); For J:=1 to N do If Chon[j]=False then Write(A[j]:4); Writeln; Inc(Dem); End; End; {********************************************************************} Procedure Tim(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; {********************************************************************} 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 tong<min then Begin min:=tong;{So sanh de tim ra TONG nho nhat} for j:=1 to n do b[j]:=a[j];{Giu lai suc lam viec cau nguoi j} End; End; {***************************************************************************} Procedure truyhoi(i:byte); var j,k:byte; begin if i=n+1 then Output Else for j:=1 to n do if Chon[j]=False then {Neu cong viec chua duoc chon} Begin A[i]:=j;{Nguoi thu i se chon cong viec j} 9

Mét sè bµi to¸n Tin häc chän läc

NguyÔn §×nh ChiÕn

Tong:=Tong+C[i,j];{Tinh TONG cac cong suc lam viec cua nguoi i voi viec j} Chon[j]:=true;{Danh dau cong viec J duoc chon} Truyhoi(i+1);{Xet nguoi tiep theo} Tong:=Tong-c[i,j];{Bot lai cong suc lam viec J cua nguoi I} Chon[j]:=False;{Tra lai cong viec J} End; end; {***************************************************************************} Begin clrscr; randomize; Nhap; writeln; Fillchar(Chon,Sizeof(chon),False); Min:=65000;{Xuat phat gia tri ban dau cua Min} Tong:=0; Truyhoi(1); writeln('Cong viec duoc sap xep lai la:'); write('Nguoi thu :');for j:=1 to n do write(j:4);writeln; write('Cong viec :');for j:=1 to n do write(b[j]:4);writeln; write('Suc Lam :');for j:=1 to n do write(c[j,b[j]]:4);writeln; writeln('Cong suc bo ra la:',min); Readln; end. {De 211:Cho truoc so tu nhien N.Lap thuat toan cho biet N co the bieu dien thanh tong cua hai hay nhieu so tu nhien lien tiep hay khong? Trong truong hop co ,hay the hien tat ca cac cach co the co. GIAI THUAT:Vet can tat cac cac truong hop xay voi dieu kien so duoc chon sau phai lon hon so duoc chon truoc} Program De_so_211; uses crt; var a:array[1..255]of byte;{Chua cac so duoc chon} n:byte;{So muon phan tich} k:byte;{So luong So duoc chon} tong:byte;{Chua tong cac so duoc chon ,de so sanh voi N} solan:word;{So luong cac cach bieu dien} {******************************************************************} Procedure print; var j:byte; begin solan:=solan+1;{Tang so cach bieu dien} write('Cach thu ',solan,':'); for j:=1 to k do begin write(a[j]);if j<k then write('+');end; writeln('=',n); if (solan mod 24)=0 then begin readln;clrscr; writeln('Press Enter to continue');readln; end; end; {******************************************************************} Procedure tim(i:byte); var j:byte; begin if tong=n then print else for j:=1 to n-1 do if (j+tong<=n) and (i<j) then {Dieu kien de so duoc chon:So do cong voi tong cu <=N,So chon sau phai lon hon so chon truoc} begin tong:=tong+j;{Cong so duoc chon vao tong} inc(k); 10

Mét sè bµi to¸n Tin häc chän läc

NguyÔn §×nh ChiÕn

a[k]:=j;{Ghi nhan so duoc chon} Tim(j);{Tim so tiep theo} dec(k);{Lui lai} tong:=tong-j;{Bot di so j de quay lui} end; end; {******************************************************************} Begin clrscr; solan:=0; write('N:');readln(n); writeln('Voi N=',n,' ta co cac cach phan tich thanh tong cac so tu nhien'); tong:=0;k:=0; tim(0); writeln('Co tat cac ',solan,' cach'); readln; end. {De 211:Cho truoc so tu nhien N.Lap thuat toan cho biet N co the bieu dien thanh tong cua hai hay nhieu so tu nhien lien tiep hay khong? Trong truong hop co ,hay the hien tat ca cac cach co the co. GIAI THUAT:Vet can tat cac cac truong hop xay voi dieu kien so duoc chon sau phai lon hon so duoc chon truoc} Program De_so_211; uses crt; var a:array[1..255]of byte;{Chua cac so duoc chon} n:byte;{So muon phan tich} k:byte;{So luong So duoc chon} tong:byte;{Chua tong cac so duoc chon ,de so sanh voi N} solan:word;{So luong cac cach bieu dien} {******************************************************************} Procedure print; var j:byte; begin solan:=solan+1;{Tang so cach bieu dien} write('Cach thu ',solan,':'); for j:=1 to k do begin write(a[j]);if j<k then write('+');end; writeln('=',n); if (solan mod 24)=0 then begin readln;clrscr; writeln('Press Enter to continue');readln; end; end; {******************************************************************} Procedure tim(i:byte); var j:byte; begin if tong=n then print else for j:=1 to n-1 do if (j+tong<=n) and (i<j) then {Dieu kien de so duoc chon:So do cong voi tong cu <=N,So chon sau phai lon hon so chon truoc} begin tong:=tong+j;{Cong so duoc chon vao tong} inc(k); a[k]:=j;{Ghi nhan so duoc chon} Tim(j);{Tim so tiep theo} dec(k);{Lui lai} tong:=tong-j;{Bot di so j de quay lui} end; end; {******************************************************************} Begin 11

Mét sè bµi to¸n Tin häc chän läc

NguyÔn §×nh ChiÕn

clrscr; solan:=0; write('N:');readln(n); writeln('Voi N=',n,' ta co cac cach phan tich thanh tong cac so tu nhien'); tong:=0;k:=0; tim(0); writeln('Co tat cac ',solan,' cach'); readln; end. {Co N ban trai va N ban gai cung den 1 cuoc khieu vu .Biet rang moi ban trai quen voi 2 ban gai va moi ban gai quen voi 2 ban trai.Lap cach chia 2N ban tran thanh N doi nhay sao cho moi doi nhay gom 2 ban da quen nhau GIAI THUAT:Quay lui. Ban Nu nao da duoc moi khieu vu cung voi nguoi ban trai ma minh quen thi ban do khong duoc chon nua.Neu chon duoc dung N cap thi Print,neu khong thi quay lai chon cach khac} Program De_so_216; uses crt; const n=8;{So cap} type arr=array[1..n,1..n]of byte; var A:arr;{Quan he cua N ban nam va N ban nnu} dem:byte;{Dem so lan chon} dance:array[1..n]of boolean;{Xet xem ban Nu duoc chon chua} nguoi:array[1..n]of integer;{Luu tru lai nhung ban nu duoc chon} {************************************************************} Procedure readfile; var f:text;i,j:byte; begin assign(f,'a:\216.dat'); reset(f); i:=0; while not eof(f) do begin inc(i);j:=0; while not eoln(f) do begin inc(j); read(f,A[i,j]); gotoxy(j*7,i+1); write(A[i,j]); end; readln(f); end; end; {************************************************************************} Function Ok(a:arr):boolean; {Kiem tra xem quan he ban dau co dung qui dinh khong: 2 nam quen voi 2 nu va nguoc lai} var tong1,tong2,i,j:byte; begin Ok:=false; for i:=1 to n do begin tong1:=0;tong2:=0; for j:=1 to n do begin if a[i,j]=1 then tong1:=tong1+1; if a[j,i]=1 then tong2:=tong2+1; if (tong1>2) 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<n then begin write('So xang ton khi di tu TP ',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)<Min) then Test Else For J:=1 to N do If (Chon[j]=False) and (Q=false) then Begin Chon[j]:=true; Inc(K); A[k]:=P[j]; Sum:=Sum+P[j]; Try(j); Chon[j]:=False; Dec(K); Sum:=Sum-P[j]; End; End; {*********************************************************************} Begin Clrscr; Randomize; Input; Sort(P,N); Sum:=0; Min:=TB; Q:=False; K:=0; Try(1); Writeln('Khoi thu 1:'); For I:=1 to K1 do write(L[i]:4); Writeln; Writeln('Tong khoi luong cua ',k1,' do vat khoi 1 la:',Kl); Writeln('Khoi thu 2:'); For I:=1 to N do If Chon2[i]=False then Write(P[i]:4); Writeln; Writeln('Tong khoi luong cua ',n-k1,' do vat khoi 2 la:',Tong-Kl); Readln; End. {De_so_380:Cho truoc 4 so tu nhien bat ky.Hay datcac dau + hoac - truoc chung sao cho tong thu duoc chia het cho 10 Lap chuong trinh tinh tong do} Program DE_380; Uses crt; Const Dau:Array[1..2]of char=('+','-'); N=4; Var A,Luutru:array[1..N] of Word; D:array[1..N] of char; I,Sl:byte; Tong:Integer;{Luu tru gia tri} 18

Mét sè bµi to¸n Tin häc chän läc

NguyÔn §×nh ChiÕn

{******************************************************************} Procedure Print; Var J:byte; Begin If (Tong mod 10)=0 then Begin inc(sl);write('('); For j:=1 to N do write(d[j],a[j]); writeln(')=10*k');; End; End; {******************************************************************} Procedure Truyhoi(I:byte); Var J:byte; Begin If I>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 (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 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 A<B then Min:=A else Min:=B; End; {*********************************************************************} Function Ok:boolean; Begin Ok:=false; If Dientich(A2,B2)>Dientich(A1,B1) then If (Max(A1,B1)<Max(A2,B2)) and (Min(A1,B1)<Min(A2,B2)) then OK:=true End; {*********************************************************************} Begin Clrscr; Randomize; Input; Ve(Max(A1,B1),Min(A1,B1),2); Ve(Max(A2,B2),Min(A2,B2),1); Gotoxy(1,24); If OK then Writeln('Hinh chu nhat thu 1 co the nam trong hinh chu nhat thu 2') else Writeln('Hinh chu nhat thu 1 khong the nam trong hinh chu nhat thu 2'); readln; End. {De_so_42:Cho ma tran vuong A[i,j] (i,j=1,2,..,n).Cac phan tu cua A duoc danh so tu 1 den NxN. Goi S la so luong cac "tu giac" A[i,j],A[i,j+1],A[i+1,j],A[i+1,j+1] sao cho cac so o dinh cua no xep tang theo thu tu tang dan theo chieu kim dong ho (Tinh tu 1 dinh nao do) 1/ Lap chuong trinh tinh so luong S. 2/ Lap thuat toan xac dinh A sao cho so S la: a.Lon nhat b.Nho nhat GIAI THUAT: 1/ Xet tung phan tu cua mang voi cac vi tri cua ben phai,ben duoi,ben duoi phai.Neu thoa thi tang S 2/ a.S lon nhat khi ma tran A xep tang tu trai sang phai.phai sang trai b.S nho nhat khi ma tran A xep giam tu trai sang phai} Program De_so_42; Uses crt; Const n=6; Type arr=array[1..n,1..n]of byte; Var A:arr; Th:set of byte; {*****************************************************************} Procedure Nhap; Var i,j:byte; Begin Th:=[]; For i:=1 to sqr(n) do Th:=Th+[i]; for i:=1 to N do begin for j:=1 to N do begin repeat 23

Mét sè bµi to¸n Tin häc chän läc

NguyÔn §×nh ChiÕn

A[i,j]:=random(sqr(n)+1); until (A[i,j]>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 (a<b) and (b<c) and (c<d) then Ok:=true else Ok:=false; end; {*****************************************************************} Function S:byte; Var i,j,T:byte; begin T:=0; For i:=1 to N-1 do For j:=1 to N-1 do if Ok(A[i,j],A[i,j+1],A[I+1,j+1],A[i+1,j]) then T:=T+1; S:=T; end; {*****************************************************************} Procedure Nhaptang; Var i,j,K:byte; Begin K:=1; for i:=1 to N do begin if odd(i) then for j:=1 to N do begin A[i,j]:=K; inc(k); end else for j:=N downto 1 do begin A[i,j]:=K; inc(k); end; end; for i:=1 to n do begin for j:=1 to n do write(A[i,j]:4); writeln; end; end; {*****************************************************************} Procedure Nhapgiam; Var I,j,k:Byte; Begin K:=Sqr(N); For i:=1 to N do begin For j:=1 to N do begin A[i,j]:=K; write(A[i,j]:4); Dec(k); 24

Mét sè bµi to¸n Tin häc chän läc

NguyÔn §×nh ChiÕn

end; writeln; end; end; {*****************************************************************} begin clrscr; randomize; repeat clrscr; writeln('Ma tran A ban dau:'); Nhap; writeln('S=',s); until s<>0; writeln('S lon nhat khi ta xep ma tran A nhu sau:'); Nhaptang; writeln('Smax=',s); writeln('S nho nhat khi ta xep ma tran A nhu sau:'); Nhapgiam; writeln('Smin=',s); readln; end. {De_so_422:Day nhi phan goi la "Gon" neu khong co hai so 0 nao dung canh nhau .Lap chuong trinh in ra tat ca cac day nhi phan "Gon" do dai n. GIAI THUAT:vet can va quay lui + Th1:Chuoi nhi phan xuat phat ban dau la '1' + Th2:Chuoi nhi phan xuat phat ban dau la '0'} Program DE_so_422; Uses crt; Var st:string;N:byte;Solan:word; Procedure Print; Var J:byte; Begin Inc(solan); If (Solan mod 10)=0 then readln; For J:=1 to N do write(St[J]); writeln; End; Procedure Truyhoi(I:byte); Var KTC:char; Begin If I>N 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 M<N; Sl:=0;{So luong ban dau} St:='1';{Phan tu xuat phat cua chuoi} M1:=1;{So luong ky tu 1 co trong chuoi la 1} Truyhoi(2); St:='0';{Phan tu xuat phat cua chuoi} M1:=0;{So luong ky tu 1 co trong chuoi la 0} Truyhoi(2); Writeln('So luong cac day nhi phan "Gon " thoa man de bai la:',Sl); readln; end. {De_so_424:Day nhi phan duoc goi la "Gon" bac K bat ky neu khong co K so 0 nao dung canh nhau .Lap Chuong trinh in ra tat ca cac day nhi phan "Gon" bac K do dai N. Lap chuong trinh in ra tat ca cac day nhi phan "gon" bac K,do dai N va chua dung M so 1} Program De_so_424; Uses crt; 26

Mét sè bµi to¸n Tin häc chän läc

NguyÔn §×nh ChiÕn

Var St:string; M,N:Byte; M1,K,K1:Byte; SL:word; {*****************************************************************} Procedure Print; Var J:byte; Begin If M1=M then Begin Writeln(ST); SL:=Sl+1; If (SL mod 20)=0 then Begin write('Press Enter to continue'); readln; End; 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]<>'0') or (Kt='1') or (ST[i-1]='0') and (K1<K-1) then Begin If Kt='0' then K1:=K1+1 Else If KT='1' then Begin K1:=0; M1:=M1+1; End; ST:=ST+KT; Truyhoi(i+1); If KT='1' then M1:=M1-1; DElete(ST,I,1); End; End; {*****************************************************************} Begin Clrscr; Write('Nhap N:');readln(n); Repeat Write('Nhap M:');readln(M); Write('Nhap K:');readln(K); Until (K<N) and (M<N); ST:='1'; M1:=1; K1:=0; Sl:=0; Truyhoi(2); ST:='0'; M1:=0; K1:=1; Truyhoi(2); Writeln('Co ',sl,' xau nhi phan "Gon" thoa yeu cau de bai'); readln; End. {Chung minh rang so cach bieu dien cua so N thanh tong cua M so nguyen duong 27

Mét sè bµi to¸n Tin häc chän läc

NguyÔn §×nh ChiÕn

bang so cach bieu dien cua so cach bieu dien cua so N-M thanh tong cac so hang <=M. Vi du:N=8;M=3; 8=1+1+6=1+2+5=1+3+4=2+2+4=2+3+3 8-3=1+1+1+1+1=1+1+1+2=1+1+3=1+2+2=2+3 GIAI THUAT:* Phan tich N thang tong cua cac so.Neu N bang tong cua M so Thi chon cach bieu dien do (*) * Phan tich N-M thanh tong cua cac so. Chon cac cach bieu dien do (**) CHU Y:Neu M>N 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<I do Begin Temp:=S[I]; S[I]:=S[J]; S[J]:=temp; Dec(I); Inc(J); End; End; {*********************************************************************} Procedure Xuly; Var I,j,K,L:byte;St1,St2:String;Temp:char;q:boolean; Begin If Ktra(S1,S2)=False Then Begin Writeln('Hai xau ',s1,' va ',s2,' khong tuong duong'); Exit; End; Writeln('Hai xau tuong duong.Cac phep bien doi ',S1,' thanh ',s2,' la:'); Write(S1,'->'); 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 (J<K) then If N[j]>Trungbinh 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 k<min then {so sanh de tim ra duong di it dao nhat} begin for l:=1 to k do b[l]:=giu[l];{Luu tru duong di qua it dao nhat} min:=k; end; writeln; end else for j:=1 to n do if (chon[j]=false) and (dodai(dao[i],dao[j])<=m) then {Dieu kien thoa:Dao j chua duoc chon va khoang cach thu Daoj voi Daoi duoc chon truoc do phai nho hon M} begin inc(k); giu[k]:=j;{Luu tru dao vua tim duoc} chon[j]:=true;{Danh dau dao j da duoc chon} tim(j);{xet Dao j voi cac dao chua chon con lai} chon[j]:=false; {Xoa bo viec danh dau} dec(k); end; end; {*********************************************************************} begin clrscr; randomize; nhap; writeln; k:=1; dem:=0;{Khoi dong dem} fillchar(chon,sizeof(chon),false); 38

Mét sè bµi to¸n Tin häc chän läc

NguyÔn §×nh ChiÕn

chon[start]:=true; giu[k]:=start; min:=n+1; tim(start); if dem>0 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 I<J do Begin Temp:=NUmber[I]; Number[i]:=Number[J]; Number[j]:=Temp; Inc(I);DEc(J); End; End; {**********************************************************************} Procedure Fill(Var Number:String); Begin Fillchar(Number,sizeof(Number),' '); End; {**********************************************************************} Function Maxlength(Number1,number2:String):Byte; Begin If Length(Number1)>Length(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)<max do Number1:=Number1+' '; While Length(Number2)<max do Number2:=Number2+' '; End; {**********************************************************************} Procedure Cong(Number1,Number2:String;Var Number3:String); Var I,Tong:byte;Memo,Max:Byte; Begin Memo:=0; BackSt(Number1); BackSt(Number2); Number3:=''; Max:=Maxlength(Number1,Number2); AddBlank(Number1,Number2,Max); For I:=1 to Max do Begin Tong:=So[Change(Number1[i])]+So[Change(Number2[i])]+Memo; If Tong>=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 K<I do Begin Num:=Num+' ';Inc(K);End; Output(Num); Cong(Number,Num,Number3); Number:=Number3; 41

Mét sè bµi to¸n Tin häc chän läc

NguyÔn §×nh ChiÕn

End; End; {**********************************************************************} Begin Repeat Clrscr; write('So thu nhat:'); Input(Number1); Write('So thu hai:'); Input(Number2); Clrscr; Output(Number1); Output(Number2); Output('___________________________________________'); Nhan(Number1,Number2,Number3); Output('-------------------------------------------------------------------'); Output(Number3); Gotoxy(1,25);write('Press Esc to Exit ,Any keys to continue'); Ch:=readkey; Until Ch=#27; End. {Mot chuyen phi co co 20 cho ngoi chua day hanh khach danh so tu 1 den 20 bi nan phai tha du tung hanh khach xuong de phi co nhe bot.Nguo ta thoa thuan nhu sau:Chon 1 so nguyen duong N bat ky,bat dau dem theo thu tu so ghe tu ghe so 1 toi so da chon(neu den ghe so 20 thi quay tro lai ghe so 1) thi nguoi ngoi ghe do phai nhay dsu .Sau do tiep tuc dem tu ghe cua nguoi vua nhay du toi so N nhu tren (bo qua cac ghe cua nyug nguoi da nhay du) va cu tiep tuc nhu the cho toi khi chi con 1 hang khach. 1) Viet chuong trnh cho nguoi dung nhap so N va xac dinh nguoi ngoi ghe thu may se con lai sau cung tren may bay. 2) Viet chuong trinh cho nguoi dung chon mot ghe va xac dinh so N nho nhat se bang may de nguoi ngoi ghe da chon con lai tren may bay sau cung.} Program De_thi_tin_hoc_khong_chuyen_1996; Uses Crt; Const Songuoi=20; Var N,I,Ghe:byte; Chon:array[1..songuoi]of boolean; Procedure Nhay(x:byte); Var I:byte; Begin for i:=2 to 25 do begin gotoxy(x,i-1);write(' '); gotoxy(x,i);write('*'); delay(1); end; End; Procedure Cau1(n:byte); Var I,number,M:byte; a:array[1..songuoi] of byte; Begin fillchar(chon,sizeof(chon),false); For I:=1 to songuoi do A[i]:=i; for I:=1 to songuoi do begin gotoxy(i*3,1);write('*'); end; Number:=0;I:=1; Repeat m:=0; While m<n do Begin inc(i); If i>songuoi 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 x<a[i,j] then x:=a[i,j]; if y>a[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 max<a[i,j] then max:=a[i,j]; if min>a[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<a[k,j] then tg:=a[k,j]; if tg=a[i,j] then write(tg:3); end; end; end; end; begin clrscr; randomize; create(a,m,n); xuat(a); maxmin; readln end. {Cho ngau nhien 1 ma tran,Sap lai ma tran do tang dan theo duong ZicZac Vi du: 1 5 3 1 2 6 4 2 6 ====> 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

```
DOCUMENT INFO
Shared By:
Categories:
Tags:
Stats:
 views: 1066 posted: 10/19/2009 language: Vietnamese pages: 50