program concentration;
uses wincrt;
type
mat=array[1..50,1..50] of integer;
var
m:mat;
i,j,n,Dn,Deg_min:integer; procedure remplir(var m:mat; var n:integer);
var i,j:integer;
begin
write(‘donner n: ‘);
readln(n);
for i:=1 to n do
for j:=1 to n do
begin
M[i,j]:=random(2);
end;
end;
procedure determin(m:mat;n,deg_min,Dn:integer);
var nb,nb_zone,i,j,d1,c1,d2,c2:integer;
begin
nb_zone:=0;
d1:=1;
c1:=Dn;
d2:=1;
c2:=Dn;
repeat
nb:=0;
for i:=d1 to c1 do
for j:=d2 to c2 do
begin
if M[i,j]=1 then
nb:=nb+1;
end;
if nb>= Deg_min then
begin
nb_zone:=nb_zone+1;
writeln(‘zone numéro ‘,nb_zone,’ ligne: ‘,d1,’ colonne: ‘,d2,’ le nombre de 1 dans cette zone= ‘,nb);
end;
d2:=d2+dn;
c2:=c2+dn;
if d2>n then
begin
d1:=d1+Dn;
d2:=1;
c1:=c1+Dn;
c2:=Dn;
end;
until (d1>n)
end;
begin
remplir(m,n);
write(‘*********affichage du matrice******* ‘);
for i:= 1 to n do
begin
writeln;
for j:= 1 to n do
write(M[i,j],’ ‘);
{************}
end;
writeln;
repeat
write(‘donner Dn: ‘);
readln(Dn);
until(n Mod Dn =0);
repeat
write(‘donner Deg_min: ‘);
readln(Deg_min);
until(deg_min in [1..Dn*Dn]);
determin(m,n,deg_min,Dn);
end. |