Если к-й столбец прямоугольной матрицы имеет минимальную сумму элементов, определить сумму элементов столбцов до к-ого, иначе - сумму элементов столбцов после к-ого.
Unit Z433_7;
interface
Const n = 3, m = 4;
Type matr = array[1..n,1..m] of real;
mas = array[1..m] of real;
procedure p1(A:matr; Var S:mas); {записывает в массив S суммы элементов столбцов}
procedure p2(S:mas; Var nom:integer); {l - минимальный элемент массива S}
procedure p3(A:matr; l1,l2:integer; Var sum:real);
implementation
procedure p1;
Var i,j:integer;
Begin for j := 1 to m do
Begin S[j] := 0;
for i := 1 to n do
S[j] := S[j] + A[i,j];
end;
end; {p1}
procedure p2;
Var j:integer;
Smin:real;
Begin Smin := S[1];
nom := 1;
for j := 1 to m do
if S[j] < Smin then
Begin Smin := S[j];
nom := j;
end;
end; {p2}
procedure p3;
Var i,j:integer;
Begin sum := 0;
for i := 1 to n do
for j := l[1] to 1[2] do
sum := sum + A[i,j];
end; {p3}
end.
program z433_7;
uses 433_7;
const n = 3, m = 4;
Type matr = array[1..n,1..m] of real;
mas = array[1..m] of real;
Var A:matr; S:mas; i,j,k,nom:integer; sum1,sum2:real;
Begin for i := 1 to n do
for j := 1 to m do readln(A[i,j]);
readln(k);
p1(A,S); p2(S,nom);
if (nom = k) then
Begin p3(A,1,k,sum1);
Writeln (sum1)
end else
Begin p3(A,k+1,m,sum2);
writeln(sum2);
end;
end.
Если целочисленная квадратная матрица симметрична относително
Главной диагонали, обнулить все элементы, лежащие выше главной
Диагонали, и определить сумму элементов, лежащих ниже
Главной диагонали.
program z433_8;
uses Z433_8;
Var A:matr;
i,j,s:integer;
BEGIN
for i := 1 to n do
for j := 1 to n do
readln(A[i,j]);
if Sim(A) then
Begin
NulSum(A,s);
write('Сумма элементов, лежащих ниже главной диагонали: ');
writeln(s);
end
else writeln('Матрица не симметрична относительно главной диагонали.');
for i := 1 to n do
Begin
for j := 1 to n do
write(A[i,j],' ');
writeln;
end;
END.
Unit Z433_8;
interface
Const n = 3;
Type matr = array[1..n,1..n] of integer;
function Sim(A:matr):boolean;
{Возвращает true, если матрица симметрична относительно главной диагонали}
procedure NulSum(Var A:matr; Var s:integer);
{Обнуляет элементы, лежащие выше главной диагонали, и подсчитывает их сумму}
implementation
function Sim(A:matr):boolean;
Var i,j,k:integer;
b:boolean;
Begin
k := 0;
b := true;
for i := 1 to n do
for j := 1 to n do
if (j < i) and (A[i,j] <> A[j,i]) then k := k + 1;
if k <> 0 then b := false;
Sim := b;
end; {Sim}
procedure NulSum(Var A:matr; Var s:integer);
Var i,j:integer;
Begin
s := 0;
for i := 1 to n do
for j := 1 to n do
if j > i then
Begin
s := s + A[i,j];
A[i,j] := 0;
end;
end; {NulSum}
END.
Переставить в каждом столбце прямоугольной матрицы
Все отрицательные элементы в конце столбца. Распечатать
Часть полученной матрицы, состоящую из 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.
Если все точки плоскости, заданные своими координатами, попадают в круг с радиусом 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.
Если столбцы заданной прямоугольной целочисленной матрицы расположены в порядке возрастания числа нулевых элементов в них, то подсчитать число нулевых элементов во всей матрице, иначе определить столбец с максимальным количеством нулей.
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.
Если максимальный элемент квадратной матрицы находится выше главной диагонали, транспонировать матрицу,иначе определить сумму элементов строки и столбца с номерами, равными индексам максимального элемента.
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.