Một số bài tập hay (thuật toán)

[Thầy Thoại]

Vì nguồn bày này trình bày trên pascal nên xin phép post không dấu nhé:
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
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.

Các bài Viết liên quan:

• Lập trình web với PHP tại học viện...
• Các thầy(cô ) tin hoc lop 4 giúp e với
• Thu thuat soan bai giang
• help me Giáo án nghề tin học THCS 70 tiết
• Phần mềm vào Facebook chỉ bằng 1 cú click

[Thầy Thoại]

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
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
Chonanh 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 (*Hai ben cua can bang 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:Intege r;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;
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.

[Thầy Thoại]

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;
{************************************************* **********************}
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.

[Thầy Thoại]

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;
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;
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.

[Thầy Thoại]

{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}
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);
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
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;
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;
{************************************************* *************}
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:
+ 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);
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.

[Thầy Thoại]

{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
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;
{************************************************* ********************}
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}
{************************************************* *****************}
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
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
0 1 0 1 1 0 - - - - - -
1 0 3 1 1 1 - + - + + -
0 2 0 2 1 0 - - + - - -
0 0 1 0 0 2 - - - - - -
0 1 0 1 0 2 - - - - - -
1 0 1 0 2 0 - + - - - -
GIAI THUAToi 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 mot
Neu mot vi tri ma xung quanh no cac vi tri deu 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:');
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;
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.

[Thầy Thoại]

{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
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);
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_422ay 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
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_424ay 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;
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
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}
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
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.

[Thầy Thoại]

{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
N,N-1,N-2,...,2
Vi Du: S2=0110 Ta chia thanh:
1/ 0110
2/ 011
3/ 01
4/ 110
5/ 11
6/ 10
Luc do xau 1 ta cung chia theo vi tri va chieu dai nhu vay
Vi du: S1=1010 Ta chia thanh:
1/ 1010
2/ 101
3/ 10
4/ 010
5/ 01
6/ 10
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
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;
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 hop
phai 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;
{************************************************* *******************}
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":
Tren 1 luoi o vuong NxN,1 nguoi danh dau len do (mot cach bi mat) mot so
"tau chien" dang 1xK.cac tau chien nay phai roi nhau.Nguoi thu hai "tha bom"
tung o vuong va sau mot lan danh bom thu duoc cau tra loi:" trung"
hoac "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,j-1],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,j-1]:=0;
b[i,j+1]:=0;b[i+1,j-1]:=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);
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;
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 so
lan 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;
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 thoaao 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);
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);
fillchar(c,sizeof(c),true);
tim(1);
readln;
end.

[Thầy Thoại]

{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)
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;
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}
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}
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;
{************************************************* ****************}
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.

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;
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}
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];
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.

[Thầy Thoại]

{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;
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.