// PascalABC.NET 3.2, сборка 1401 от 14.03.2017 // Внимание! Если программа не работает, обновите версию!
procedure SumKolEven(a:array[,] of integer; var s,k:integer); begin var p:=a.Rows.SelectMany(x->x).Where(x->x.IsEven); s:=p.Sum; k:=p.Count end;
procedure MaxCoord(a:array[,] of integer; var imax,jmax:integer); begin (imax,jmax):=(0,0); for var i:=0 to a.RowCount-1 do for var j:=0 to a.ColCount-1 do if a[i,j]>a[imax,jmax] then (imax,jmax):=(i,j) end;
procedure ZeroEven(a:array[,] of integer); begin for var i:=0 to a.RowCount-1 do for var j:=0 to a.ColCount-1 do if a[i,j].IsEven then a[i,j]:=0 end;
procedure MaxSumRow(a:array[,] of integer; var irow:integer); begin irow:=a.Rows.Select(x->x.Sum).ToArray.IndexMax; end;
begin var n:=ReadInteger('Количество строк в массиве:'); var m:=ReadInteger('Количество столбцов в массиве:'); Writeln('*** Исходный массив [',n,',',m,'] ***'); var a:=MatrRandom(n,m,-99,99); a.Println(4); Writeln(4*a.ColCount*'-'); var sum,kol:integer; SumKolEven(a,sum,kol); Writeln('S=',sum,', k=',kol); var im,jm:integer; MaxCoord(a,im,jm); Writeln('Координаты максимума [',im+1,',',jm+1,']'); var b:=Copy(a); ZeroEven(b); b.Println(4); Writeln(4*b.ColCount*'-'); MaxSumRow(a,im); Writeln('Максимальная сумма у строки ',im+1) end.
//FPC 2.6.4 const m = 3; n = 3; var a : array[1..n, 1..m] of integer; max1: array[1..n] of integer; min1: array[1..n] of integer; max2: array[1..m] of integer; min2: array[1..m] of integer; i, j, min, max, count: integer; begin for i:=1 to n do for j:=1 to m do begin write ('Введите элемент матрицы [', i, ', ', j, ']: '); readln (a[i, j]); end;
for i:=1 to n do begin min:=a[i, 1]; max:=a[i, 1]; for j:=2 to m do begin if a[i, j]<min then min:=a[i, j]; if a[i, j]>max then max:=a[i, j]; end; min1[i]:=min; max1[i]:=max; end;
for j:=1 to m do begin min:=a[1, j]; max:=a[1, j]; for i:=2 to n do begin if a[i, j]<min then min:=a[i, j]; if a[i, j]>max then max:=a[i, j]; end; min2[j]:=min; max2[j]:=max; end;
writeln; writeln ('Введенная матрица: '); for i:=1 to n do begin for j:=1 to m do write (a[i, j]:6); writeln; end; writeln; count:=0; for i:=1 to n do for j:=1 to m do if ((a[i, j]=max1[i]) and (a[i, j]=min2[j])) or ((a[i, j]=max2[j]) and (a[i, j]=min1[i])) then begin writeln ('Седловая точка: [', i, ', ', j, ']'); inc (count); end; writeln ('Всего седловых точек: ', count); end.
// Внимание! Если программа не работает, обновите версию!
procedure SumKolEven(a:array[,] of integer; var s,k:integer);
begin
var p:=a.Rows.SelectMany(x->x).Where(x->x.IsEven);
s:=p.Sum; k:=p.Count
end;
procedure MaxCoord(a:array[,] of integer; var imax,jmax:integer);
begin
(imax,jmax):=(0,0);
for var i:=0 to a.RowCount-1 do
for var j:=0 to a.ColCount-1 do
if a[i,j]>a[imax,jmax] then (imax,jmax):=(i,j)
end;
procedure ZeroEven(a:array[,] of integer);
begin
for var i:=0 to a.RowCount-1 do
for var j:=0 to a.ColCount-1 do
if a[i,j].IsEven then a[i,j]:=0
end;
procedure MaxSumRow(a:array[,] of integer; var irow:integer);
begin
irow:=a.Rows.Select(x->x.Sum).ToArray.IndexMax;
end;
begin
var n:=ReadInteger('Количество строк в массиве:');
var m:=ReadInteger('Количество столбцов в массиве:');
Writeln('*** Исходный массив [',n,',',m,'] ***');
var a:=MatrRandom(n,m,-99,99);
a.Println(4); Writeln(4*a.ColCount*'-');
var sum,kol:integer;
SumKolEven(a,sum,kol); Writeln('S=',sum,', k=',kol);
var im,jm:integer;
MaxCoord(a,im,jm); Writeln('Координаты максимума [',im+1,',',jm+1,']');
var b:=Copy(a);
ZeroEven(b);
b.Println(4); Writeln(4*b.ColCount*'-');
MaxSumRow(a,im); Writeln('Максимальная сумма у строки ',im+1)
end.
Пример
Количество строк в массиве: 5
Количество столбцов в массиве: 8
*** Исходный массив [5,8] ***
23 94 26 40 -88 -29 88 -46
-98 64 -78 93 17 36 66 56
-52 -16 -7 -33 -63 -95 40 96
10 -30 79 -75 -47 83 30 -70
-37 -50 -80 18 -7 -43 68 -68
S=56, k=25
Координаты максимума [3,8]
23 0 0 0 0 -29 0 0
0 0 0 93 17 0 0 0
0 0 -7 -33 -63 -95 0 0
0 0 79 -75 -47 83 0 0
-37 0 0 0 -7 -43 0 0
Максимальная сумма у строки 2
const
m = 3; n = 3;
var
a : array[1..n, 1..m] of integer;
max1: array[1..n] of integer;
min1: array[1..n] of integer;
max2: array[1..m] of integer;
min2: array[1..m] of integer;
i, j, min, max, count: integer;
begin
for i:=1 to n do
for j:=1 to m do
begin
write ('Введите элемент матрицы [', i, ', ', j, ']: ');
readln (a[i, j]);
end;
for i:=1 to n do
begin
min:=a[i, 1]; max:=a[i, 1];
for j:=2 to m do
begin
if a[i, j]<min then min:=a[i, j];
if a[i, j]>max then max:=a[i, j];
end;
min1[i]:=min; max1[i]:=max;
end;
for j:=1 to m do
begin
min:=a[1, j]; max:=a[1, j];
for i:=2 to n do
begin
if a[i, j]<min then min:=a[i, j];
if a[i, j]>max then max:=a[i, j];
end;
min2[j]:=min; max2[j]:=max;
end;
writeln;
writeln ('Введенная матрица: ');
for i:=1 to n do
begin
for j:=1 to m do write (a[i, j]:6);
writeln;
end;
writeln;
count:=0;
for i:=1 to n do
for j:=1 to m do
if ((a[i, j]=max1[i]) and (a[i, j]=min2[j]))
or ((a[i, j]=max2[j]) and (a[i, j]=min1[i])) then
begin
writeln ('Седловая точка: [', i, ', ', j, ']');
inc (count);
end;
writeln ('Всего седловых точек: ', count);
end.