Tài liệu Bài Tập Tin học chọn lọc ppt

Bài Tập Tin học chọn lọc
Mét sè bμi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn

1

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
Mét sè bμi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn

2
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
Mét sè bμi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn

3
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 (*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: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;
Mét sè bμi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn

4
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
Mét sè bμi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn

5
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);
Mét sè bμi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn

6
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;
{***********************************************************************}
Mét sè bμi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn

7
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;
Mét sè bμi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn

8
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;
Mét sè bμi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn

9
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}
Mét sè bμi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn

10
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);
Mét sè bμi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn

11
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
Mét sè bμi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn

12

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;
Mét sè bμi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn

13
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;
Mét sè bμi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn

14
{**************************************************************}
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:
Mét sè bμi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn

15
+ 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);
Mét sè bμi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn

16
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
Mét sè bμi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn

17
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;
Mét sè bμi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn

18
{*********************************************************************}
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}
Mét sè bμi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn

19
{******************************************************************}
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
Mét sè bμi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn

20
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
Mét sè bμi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn

21
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 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
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:');
Mét sè bμi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn

22
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;
Mét sè bμi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn

23
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
Mét sè bμi to¸n Tin häc chän läc NguyÔn §×nh ChiÕn

24
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);