Попадают на заданный отрезок, определить номер строки
С максимальной суммой элементов, иначе определить номера строк,
Сумма элементов которых не попала на заданный отрезок.
Program z433_3;
uses z433_3;
Var A:matr;
S:mass;
L:inmass;
b:boolean;
xn,xk:real;
i,j,k:integer;
BEGIN
for i := 1 to n do
for j := 1 to m do
readln(A[i,j]);
writeln('Введите границы отрезка: ');
readln(xn,xk);
Sum(A,S);
InArea(S,xn,xk,L,k,b);
if b then writeln('Строка с максимальной суммой элементов: ',Maximum(S):5)
else Begin
writeln('Номера строк, сумма элементов которых выходит за пределы отрезка: ');
for i := 1 to k do
write(L[i],' ');
end;
readln;
END.
Unit Z433_3;
interface
Const n = 3;
m = 4;
Type matr = array[1..n,1..m] of real;
mass = array[1..n] of real;
inmass = array[1..n] of integer;
procedure Sum(A:matr; Var S:mass);
{Записывает в массив S суммы элементов строк матрицы A}
procedure InArea(S:mass; xn,xk:real; Var L:inmass; Var k:integer; Var b:boolean);
{b = true, если все элементы массива S попадают в отрезок [xn,xk], иначе
b = false и целочисленный массив L содержит k номеров элементов S,
не попавших в отрезок}
function Maximum(S:mass):integer;
{Возвращает номер максимального элемента массива S}
implementation
procedure Sum(A:matr; Var S:mass);
Var i,j:integer;
ss:real;
Begin
for i := 1 to n do
Begin
ss := 0;
for j := 1 to m do
ss := ss + A[i,j];
S[i] := ss;
end;
end; {Sum}
procedure InArea(S:mass; xn,xk:real; Var L:inmass; Var k:integer; Var b:boolean);
Var i:integer;
Begin
k := 0;
for i := 1 to n do
L[i] := 0;
for i := 1 to n do
if (S[i] < xn) or (S[i] > xk) then
Begin
k := k + 1;
L[k] := i;
end;
if k = 0 then b := true
else b := false;
end; {InArea}
function Maximum(S:mass):integer;
Var max:real;
i,k:integer;
Begin
k := 1;
max := S[1];
for i := 2 to n do
if S[i] > max then
Begin
max := S[i];
k := i;
end;
Maximum := k;
end; {Maximum}
begin
END.
4 Для заданного массива В составить процедуру формирования массива из индексов элементов, для которых f1(Bi)>f2(Bi). Дана матрица А, у которой 6 строк и 6 столбцов. Для каждой строки матрицы А определить сумму тех элементов, для которых Aik3>eAik.
Unit Z432_20;
interface
Const N=6;
type fun=function(x:real):real;
matr=array[1..N,1..N] of real;
mas=array[1..N] of real;
inmas=array[1..N] of integer;
var A:matr;B:mas;l:inmas;s:real;i,j,k,t,tt:integer;
function f1(x:real):real;
function f2(x:real):real;
procedure p(B:mas; f1,f2:fun; var l:inmas; var k:integer);
implementation
{$F+}
function f1(x:real):real;
begin f1:=sqr(x)*x end;
function f2(x:real):real;
begin f2:=exp(x) end;
{$F-}
procedure p(B:mas; f1,f2:fun; var l:inmas; var k:integer);
var i,t,tt:integer;
begin
k:=0;
for i:=1 to n do
if f1(B[i])>f2(B[i]) then begin
k:=k+1;
l[k]:=i;
end;
end; {procedure_p}
end.
program z432_20;
uses Z432_20;
type fun=function(x:real):real;
matr=array[1..N,1..N] of real;
mas=array[1..N] of real;
inmas=array[1..N] of integer;
var A:matr;B:mas;l:inmas;s:real;i,j,k,t,tt:integer;
begin{основной программы}
for i:=1 to n do
for j:=1 to n do
readln(A[i,j]); {ввод матрицы}
for i:=1 to n do begin
{перепись j-ой строки матрицы в дополнительный массив B}
for j:=1 to n do B[j]:=A[i,j];
p(B,f1,f2,l,k)
if k<>0 then begin s:=0;
for t:=1 to k do begin tt:=l[t];
s:=s+B[tt]
end;
writeln(s);
end; end;
end.
Определить столбец прямоугольной матрицы с максимальной
Суммой элементов и, если его номер больше заданного,
Сформировать матрицу из стобцов исходной до найденного
Столбца, иначе сформировать массив из элементов
Заданного столбца.
program Z433_5;
uses Z433_5;
Var A,B:matr;
C:mass1;
S:mass2;
i,j,k,G:integer;
BEGIN
for i := 1 to n do
for j := 1 to m do
readln(A[i,j]);
readln(G);
Sum(A,s);
Maximum(S,k);
if k > G then
Begin
CreateMatr(A,k,B);
for i := 1 to n do
Begin
for j := 1 to k do
write(B[i,j]:5:3,' ');
writeln;
end;
end
else Begin
CreateMass(A,k,C);
for i := 1 to n do
writeln(C[i]:5:3);
end;
readln;
END.
Unit Z433_5;
interface
Const n = 3;
m = 4;
Type matr = array[1..n,1..m] of real;
mass1 = array[1..n] of real;
mass2 = array[1..m] of real;
procedure Sum(A:matr; Var S:mass2); {записывает в массив S суммы элементов столбцов матрицы A}
procedure Maximum(S:mass2; Var k:integer); {k - максимальный элемент массива S}
procedure CreateMatr(A:matr; k:integer; Var B:matr); {формирует матрицу из столбцов исходной до k-го}
procedure CreateMass(A:matr; k:integer; Var C:mass1); {формирует массив из элементов k-го столбца исходной матрицы}
implementation
procedure Sum(A:matr; Var S:mass2);
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; {Sum}
procedure Maximum(S:mass2; Var k:integer);
Var i:integer;
max:real;
Begin
max := S[1];
k := 1;
for i := 2 to m do
if S[i] > max then
Begin
max := S[i];
k := i;
end;
end; {Maximum}
procedure CreateMatr(A:matr; k:integer; Var B:matr);
Var i,j:integer;
Begin
for i := 1 to n do
for j := 1 to k do
B[i,j] := A[i,j];
end; {CreateMatr}
procedure CreateMass(A:matr; k:integer; Var C:mass1);
Var i:integer;
Begin
for i := 1 to n do
C[i] := A[i,k];
end; {CreateMass}
END.
Если заданная квадратная целочисленная матрица является треугольной(элементы выше главной диагонали равны нулю),вычислить её среднее арифметическое, иначе определить, сколько элементов, лежащих выше главной диагонали, отличны от нуля.
program z433_6;
uses Z433_6;
Var A:matr;
i,j,k:integer;
s:real;
b:boolean;
BEGIN
for i := 1 to n do
for j := 1 to n do
readln(a[i,j]);
Triangle(A,k,b);
if b then
Begin
SrArifm(A,s);
writeln(s);
end
else writeln(k);
readln;
END.
Unit Z433_6;
interface
Const n = 3;
Type matr = array[1..n,1..n] of integer;
procedure SrArifm(A:matr; Var s:real); {s - среднее арифметическое матрицы A}
procedure Triangle(A:matr; Var k:integer; Var b:boolean);
{Если b = true, то матрица треугольная; k - число элементов выше главной диагонали, отличных от нуля}
implementation
procedure Triangle(A:matr; Var k:integer; Var b:boolean);
Var i,j:integer;
Begin
b := true;
k := 0;
for i := 1 to n do
for j := 1 to n do
if (j > i) and (A[i,j] <> 0) then
Begin
b := false;
k := k + 1;
end;
end; {Rect}
procedure SrArifm(A:matr; Var s:real);
Var i,j:integer;
Begin
s := 0;
for i := 1 to n do
for j := 1 to n do
s := s + A[i,j];
s := s / (n * n);
end; {SrArifm}
begin
END.