- •3 Если в прямоугольной матрице все суммы элементов строк
- •5 Определить столбец прямоугольной матрицы с максимальной
- •7 Если к-й столбец прямоугольной матрицы имеет минимальную сумму элементов, определить сумму элементов столбцов до к-ого, иначе - сумму элементов столбцов после к-ого.
- •8 Если целочисленная квадратная матрица симметрична относително
- •9. Переставить в каждом столбце прямоугольной матрицы
- •13 Дана квадратная матрица. Увеличить все элементы строки с минимальной суммой элементов на среднее арифметическое элементов матрицы, лежащих выше главной диагонали.
- •14 Изменить заданную прямоугольную матрицу так, чтобы
- •20 В заданной прямоугольной матрице поставить на первое место
- •21(1) Для массива с из n элементов составить процедуру, которая находит m наименьших значений с1,с2…сn и т.Д.
9. Переставить в каждом столбце прямоугольной матрицы
все отрицательные элементы в конце столбца. Распечатать
часть полученной матрицы, состоящую из n первых строк,
не имеющих отрицательных элементов.
program z433_9;
uses Z433_9;
Var A:matr;
i,j,l:integer;
BEGIN
for i := 1 to n do
for j := 1 to m do
readln(A[i,j]);
Transpos(A,l);
if l > 0 then PrintL(A,L)
else writeln('Ненулевых строк нет.');
END.
Unit Z433_9;
interface
Const n = 3;
m = 4;
Type matr = array[1..n,1..m] of real;
procedure Transpos(Var A:matr; Var l:integer);
{Переставляет в каждом столбце матрицы A все отрицательные элементы в конец столбца, l - число строк с ненулевыми элементами}
procedure PrintL(A:matr; l:integer);
{печатает l первых строк матрицы A}
implementation
procedure Transpos(Var A:matr; Var l:integer);
Var i,j,k:integer;
r:real;
Begin
l := 0;
for j := 1 to m do
Begin
k := 0;
for i := 1 to n do
Begin
while A[n-k,j] < 0 do k := k + 1;
if (A[i,j] < 0) and (i <= (n - k)) then
Begin
r := A[i,j];
A[i,j] := A[n-k,j];
A[n-k,j] := r;
k := k + 1;
end;
end;
if k > l then l := k;
end;
l := n - l;
end; {Transpos}
procedure PrintL(A:matr; l:integer);
Var i,j:integer;
Begin
for i := 1 to l do
Begin
for j := 1 to m do
write(A[i,j]:5:3,' ');
writeln;
end;
end; {PrintL}
END.
10 Если все точки плоскости, заданные своими координатами, попадают в круг с радиусом R и центром в начале координат, определить их среднюю абсциссу и ординату, иначе распечатать номера точек, не попавших в заданый круг.
Unit Z433_10;
interface
Const n = 5;
Type mass = array[1..n] of real;
function InArea(X,Y:mass; R:real):boolean;
{возвращает true, если все точки попали в круг радиусом R}
procedure SrZnach(A:mass; Var s:real);
{Вычисляет среднее значение массива A}
procedure PrintNum(X,Y:mass; R:real);
{Печатает номера точек, не попавших в круг радиусом R}
implementation
function InArea(X,Y:mass; R:real):boolean;
Var i:integer;
b:boolean;
Begin
b := true;
i := 0;
repeat i := i + 1;
if sqrt((sqr(X[i]) + sqr(Y[i]))) > R then b := false
until (not b) or (i >= n);
InArea := b;
end; {InArea}
procedure SrZnach(A:mass; Var s:real);
Var i:integer;
Begin
s := 0;
for i := 1 to n do
s := s + A[i];
s := s / n;
end; {SrZnach}
procedure PrintNum(X,Y:mass; R:real);
Var i:integer;
Begin
for i := 1 to n do
if sqrt((sqr(X[i]) + sqr(Y[i]))) > R then write(i,' ');
end; {PrintNum}
END.
program z433_10;
uses Z433_10;
Var X,Y:mass;
i:integer;
R,sx,sy:real;
BEGIN
for i := 1 to n do
Begin
write('X: ');
readln(X[i]);
write('Y: ');
readln(Y[i]);
end;
write('R: ');
readln(R);
if InArea(X,Y,R) then
Begin
SrZnach(X,sx);
SrZnach(Y,sy);
writeln('A: ',sx,' O: ',sy)
end
else Begin
write('N: ');
PrintNum(X,Y,R);
end;
END.
11 Если столбцы заданной прямоугольной целочисленной матрицы расположены в порядке возрастания числа нулевых элементов в них, то подсчитать число нулевых элементов во всей матрице, иначе определить столбец с максимальным количеством нулей.
program z433_11;
uses Z12433_11;
Var A:matr;
S:mass;
i,j,ch,nmax:integer;
BEGIN
for i := 1 to n do
for j := 1 to m do
readln(A[i,j]);
NulS(A,S);
if Vozr(S) then
Begin
NulCh(S,ch);
write('ch: ');
writeln(ch);
end
else Begin
Maximum(S,nmax);
write('nmax: ');
writeln(nmax);
end;
END.
Unit Z433_11;
interface
Const n = 3;
m = 4;
Type matr = array[1..n,1..m] of integer;
mass = array[1..m] of integer;
procedure NulS(A:matr; Var S:mass);
{Записывает в массив S число нулей в каждом столбце}
function Vozr(S:mass):boolean;
{возвращает true, если в массиве S элементы расположены в порядке возрастания}
procedure NulCh(S:mass; Var ch:integer);
{ch - количество нулей в матрице}
procedure Maximum(S:mass; Var nmax:integer);
{nmax - номер столбца с максимальным количеством нулей}
implementation
procedure NulS(A:matr; Var S:mass);
Var i,j,k:integer;
Begin
for j := 1 to m do
Begin
k := 0;
for i := 1 to n do
if A[i,j] = 0 then k := k + 1;
S[j] := k;
end;
end; {NulS}
function Vozr(S:mass):boolean;
Var i,k:integer;
b:boolean;
Begin
k := 0;
for i := 2 to m do
if S[i] > S[i-1] then k := k + 1;
if k = m - 1 then b := true
else b := false;
Vozr := b;
end; {Vozr}
procedure NulCh(S:mass; Var ch:integer);
Var i:integer;
Begin
ch := 0;
for i := 1 to m do
ch := ch + S[i];
end; {NulCh}
procedure Maximum(S:mass; Var nmax:integer);
Var i,max:integer;
Begin
max := S[1];
nmax := 1;
for i := 2 to m do
if S[i] > max then
Begin
max := S[i];
nmax := i;
end;
end; {Maximum}
END.
12,Если максимальный элемент квадратной матрицы находится выше главной диагонали, транспонировать матрицу,иначе определить сумму элементов строки и столбца с номерами, равными индексам максимального элемента.
program z433_12;
uses Z433_12;
Var A:matr;
i,j,k,l:integer;
b:boolean;
s:real;
BEGIN
for i := 1 to n do
for j := 1 to n do
readln(A[i,j]);
Maximum(A,k,l,b);
if b then
Begin
Transpos(A);
for i := 1 to n do
Begin
for j := 1 to n do
write(A[i,j]:5:3,' ');
writeln;
end; end
else Begin
Sum(A,k,l,s);
write('Сумма элементов строки и столбца, содержащих максимальный элемент: ');
writeln(s:5:3); end;END.
Unit Z433_12;
interface
Const n = 3;
Type matr = array[1..n,1..n] of real;
procedure Maximum(A:matr; Var k,l:integer; Var b:boolean);
{b = true, если максимальный элемент матрицы находится выше главной диагонали, k,l - индексы максимального элемента}
procedure Transpos(Var A:matr);{Транспонирует матрицу}
procedure Sum(A:matr; k,l:integer; Var s:real);
{s - сумма элементов k-й строки и l-го столбца}
implementation
procedure Maximum(A:matr; Var k,l:integer; Var b:boolean);
Var i,j:integer;
max:real;
Begin
k := 1;l := 1;
max := A[1,1];
for i := 1 to n do
for j := 1 to n do
if A[i,j] > max then
Begin
max := A[i,j];
k := i;
l := j;
end;
if l > k then b := true
else b := false;
end; {Maximum}
procedure Transpos(Var A:matr);
Var i,j:integer;
r:real;
Begin
for i := 1 to n do
for j := 1 to n do
if i > j then
Begin
r := A[i,j];
A[i,j] := A[j,i];
A[j,i] := r;
end;end; {Transpos}
procedure Sum(A:matr; k,l:integer; Var s:real);
Var i:integer;
Begin
s := 0;
for i := 1 to n do
s := s + A[i,l] + A[k,i];
s := s - A[k,l];
end; {Sum}END.