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:

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;

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

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

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

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

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

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


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

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;

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;

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

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

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;

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;

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

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

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}

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

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

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;

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

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

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]:='-';

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('*');

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

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