Matrix, Pascal - rextester

Language: Layout:

program SimetrikMatrix;

const
max1=50;max2=50;
type
matrix=array[1..max1,1..max2] of integer;
var
a,b:matrix;
n,m:integer;

procedure makematrix(var a:matrix;var n,m:integer);
var
i,j:integer;
indikator:boolean;
begin
indikator:=false;
repeat
writeln('Input number of cols and rows');
read(n,m);
if (n<0) or (m<0) or (n>max1) or (m>max2) then writeln('Gresla!')
else indikator:=true;
until indikator;
writeln('Input elements of matrix: ');
for i:=1 to n do
for j:=1 to m do
read(a[i][j])
end;

procedure writematrix(a:matrix;n,m:integer);
var
i,j:integer;
begin
writeln('Your matrix is: ');
for i:=1 to n do begin
for j:=1 to m do write(a[i][j],' ');
writeln()
end
end;

function issimetric(a:matrix;j,n:integer):boolean;
var
prvi,poslednji:integer;
indikator:boolean;
begin
indikator:=true;
prvi:=1;
poslednji:=n;
while indikator and (prvi<poslednji) do begin
if not(a[prvi][j]=a[poslednji][j]) then indikator:=false
else begin
prvi:=prvi+1;
poslednji:=poslednji-1
end
end;
issimetric:=indikator
end;

procedure writerow(a:matrix;j,n:integer);
var
i:integer;
begin
write('with index ',j,' : ');
for i:=1 to n do write (a[i][j],' ');
writeln()
end;

procedure processing3(a:matrix;n,m:integer);
var
j:integer;
begin
writeln('Simetric rows are: ');
for j:=1 to m do 
if issimetric(a,j,n) then writerow(a,j,n)
end;

function check(a:matrix;i,j,n,m:integer):boolean;
begin
if (a[i][j]<a[n][m]) then check:=true
else check:=false
end;

function isthesmallest(a:matrix;i,j,n,m:integer):boolean;
var
up,down,left,right:boolean;
begin
if (i=1) then up:=true
else up:=check(a,i,j,i-1,j);
if (i=n) then down:=true
else down:=check(a,i,j,i+1,j);
if (j=1) then left:=true
else left:=check(a,i,j,i,j-1);
if(j=m) then right:=true
else right:=check(a,i,j,i,j+1);
if up and down and left and right then isthesmallest:=true
else isthesmallest:=false
end;

procedure processing4(a:matrix;n,m:integer);
var
i,j:integer;
begin
writeln('Elements that are smaller then all their neighbours are: ');
for i:=1 to n do
for j:=1 to m do
if isthesmallest(a,i,j,n,m) then writeln(a[i][j],' on position ',i,' , ',j)
end;

procedure makematrix1(var a:matrix;n,m:integer);
var
i,j:integer;
begin
writeln('Input elements of second matrix: ');
for i:=1 to n do
for j:=1 to m do
read(a[i][j])
end;

function skalarni(a,b:matrix;i,m:integer):integer;
var
j,s:integer;
begin
s:=0;
for j:=1 to m do s:=s+a[i][j]*b[i][j];
skalarni:=s;
end;

function foundmaximal(c:array of integer;n:integer):integer;
var
big,i:integer;
begin
big:=c[0];
for i:=1 to n-1 do
if(c[i]>big) then big:=c[i];
foundmaximal:=big
end;

procedure processing5(a,b:matrix;n,m:integer);
var
i:integer;
c:array[1..max2] of integer;
begin
writeln('Skalar products: ');
for i:=1 to n do begin
c[i]:=skalarni(a,b,i,m);
write(c[i],' ')
end;
writeln();
writeln('Maximal scalar product is: ',foundmaximal(c,n))
end;

procedure issimetricmain(a:matrix;n:integer);
var
i,j:integer;
ind:boolean;
begin
ind:=true;i:=1;
while(i<n) and ind do begin
for j:=i to n do if not(a[i][j]=a[j][i]) then ind:=false;
i:=i+1
end;
if ind then writeln('Matrix is simetrical over main diagonal!')
else writeln('Matrix is NOT simetrical over main diagonal!')
end;

procedure issimetric(a:matrix;n:integer);
var
i,j:integer;
ind:boolean;
begin
ind:=true;i:=1;
while(i<n) and ind do begin
for j:=1 to n-i do
if not(a[i][j]=a[n-j+1][n-i+1]) then ind:=false;
i:=i+1
end;
if ind then writeln('Matrix is simetrical over auxiliary diagonal!')
else writeln('Matrix is NOT simetrical over auxiliary diagonal!')
end;

function aritmetic1(a:matrix;n:integer):real;
var
i:integer;
s:real;
begin
s:=0.0;
for i:=1 to n do
s:=s+1.*a[i][i];
aritmetic1:=s/n
end;

function aritmetic2(a:matrix;n:integer):real;
var
i:integer;
s:real;
begin
s:=0.0;
for i:=1 to n do
s:=s+1.*a[i][n-i+1];
aritmetic2:=s/n
end;

procedure processing7(a:matrix;n:integer);
label err;
var
i,j:integer;
ar1,ar2,min,max:real;
begin
ar1:=aritmetic1(a,n);
ar2:=aritmetic2(a,n);
if (ar1>ar2) then min:=ar2 
else if (ar1<ar2) then min:=ar1
else goto err;
max:=ar1+ar2-min;
writeln('Opseg (',min:0:2,',',max:0:2,')');
writeln('Odgovarajuci elementi matrice su: ');
for i:=1 to n do
for j:=1 to m do
if (min<a[i][j]) and (max>a[i][j]) then writeln(a[i][j],', na poziciji ',i,',',j);
err:end;

begin
makematrix(a,n,m);
writematrix(a,n,m);
processing3(a,n,m);
processing4(a,n,m);
makematrix1(b,n,m);
writematrix(b,n,m);
processing5(a,b,n,m);
writeln('Is first matrix simetrical over diagonal?');
if(n=m) then issimetricmain(a,n);
if(n=m) then issimetric(a,n);
writeln('Is second matrix simetrical over over diagonal?');
if(n=m) then issimetricmain(b,n);
if(n=m) then issimetric(b,n);
processing7(a,n);
processing7(b,n)
end.

​x
if (min<a[i][j]) and (max>a[i][j]) then writeln(a[i][j],', na poziciji ',i,',',j);
 
program SimetrikMatrix;
​
const
max1=50;max2=50;
type
matrix=array[1..max1,1..max2] of integer;
var
a,b:matrix;
n,m:integer;
​
procedure makematrix(var a:matrix;var n,m:integer);
var
i,j:integer;
indikator:boolean;
begin
indikator:=false;
repeat
writeln('Input number of cols and rows');
read(n,m);
if (n<0) or (m<0) or (n>max1) or (m>max2) then writeln('Gresla!')
else indikator:=true;
until indikator;
writeln('Input elements of matrix: ');
for i:=1 to n do
for j:=1 to m do
read(a[i][j])
end;
​
procedure writematrix(a:matrix;n,m:integer);
var
i,j:integer;
begin
writeln('Your matrix is: ');
for i:=1 to n do begin
for j:=1 to m do write(a[i][j],' ');
writeln()
end

Show compiler warnings [ - ] Show input
Compilation time: 0.24 sec, absolute running time: 0.12 sec, cpu time: 0.04 sec, memory peak: 3 Mb, absolute service time: 0,47 sec