Попадают на заданный отрезок, определить номер строки

С максимальной суммой элементов, иначе определить номера строк,

Сумма элементов которых не попала на заданный отрезок.

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 Для заданного массива В составить процедуру формирования массива из индексов элементов, для которых f₁(B_i)>f₂(B_i). Дана матрица А, у которой 6 строк и 6 столбцов. Для каждой строки матрицы А определить сумму тех элементов, для которых A_ik³>e^Aik.

 

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.