program ex1_efg;
type
mat = array[1..2, 1..2] of boolean;
arrmat = array[1..16] of mat;
res = array[1..16, 1..16] of integer;
var
mmm: mat;
m: arrmat;
resmat: res;
i, j, k, n, x: integer;
procedure init (var a: arrmat);
var
i, j, k, n, x: integer;
begin
x := 1;
for i := 1 to 2 do
for j := 1 to 2 do
for k := 1 to 2 do
for n := 1 to 2 do
begin
a[x][1, 1] := i = 1; {
si i=1 renvoie true sinon renvoie false }
a[x][1, 2] := j = 1;
a[x][2, 1] := k = 1;
a[x][2, 2] := n = 1;
x := x + 1;
end;
end; { Fin de
'init' }
procedure somme (m, mm: mat; var mmm: mat);
var
i, j: integer;
begin
for i := 1 to 2 do
for j := 1 to 2 do
mmm[i, j] := m[i, j] = mm[i, j];
end; { Fin de
'adittion' }
function egalite (m, mm: mat): boolean;
begin
egalite := (m[1, 1] = mm[1, 1]) and
(m[1, 2] = mm[1, 2]) and (m[2, 1] =
mm[2, 1]) and (m[2, 2] = mm[2,
2]);
end; { Fin de
'egalite' }
function num (m: mat; a: arrmat): integer;
{ Question e
}
var
k: integer;
begin
k := 0;
repeat
k := k + 1;
until egalite(m, a[k]) = true;
num := k;
end; { Fin de
'num' }
procedure tabule (a: arrmat; var r: res);
var
i, j: integer;
prov: mat;
begin
for i := 1 to 16 do
for j := i to 16 do
begin
somme(a[i], a[j], prov);
k := num(prov, a);
resmat[i, j] := k;
resmat[j, i] := k;
end;
end; { Fin de
'tabule' }
begin { corps du
progarmme }
{ A l'intersection de la i ème ligne et de la j
ème colonne on doit mettre l'indice de la matrice
résultat }
{ de l'somme de ces deux matrices Pour cela on
réutilise les procedures dejà
calculées. }
writeln('Exercice 1 e-f-g
www.Software-DS.com');
writeln('Création d''une matrice 16x16 d''entiers
qui');
writeln('correspondent à l''indice de la matrice
solution');
writeln('de l''somme de la matrice i et j.');
writeln;
init(m); {
Calcul des 16 matrices distinctes. }
writeln('Think Different
:-)');
tabule(m, resmat);
{ Affichage de
la matrice solution (dim=16x16) }
write(' ');
for i := 1 to 16 do
write(i : 3);
writeln;
for i := 1 to 18 do
write('---');
writeln;
for i := 1 to 16 do
begin
write(i : 3, ' |');
for j := 1 to 16 do
write(resmat[i, j] : 3);
writeln;
end;
writeln;
writeln('©2001 All Rights Reserved to
www.Software-DS.com');
{ ©2001 All
Rights Reserved to http://www.Software-DS.com
06/11/01 }
end.
|