1 В прямоугольной матрице в каждом столбце поставить на первое место максимальный элемент столбца и, если среди полученных элементов первой строки не окажется элементов, по модулю меньших заданной величины, разделить элементы последней строки на соотвутствующие элементы первой строки.

Unit Z433_1;

interface

Const n=3;m=5;

Type matr=array[1..n,1..m] of real;

Var i,j:integer;

t,p:boolean;

a:matr;

eps:real;

procedure vvod(Var a:matr; eps:real);

procedure proverka(Var t:boolean;eps:real;a:matr);

procedure proverka1(Var p:boolean;a:matr);

procedure delenie(Var a:matr);

procedure sortirovka(Var a:matr;j:integer);

implementation

procedure vvod(Var a:matr; eps:real);

Begin

writeln('введите матрицу ');

for i:=1 to n do

for j:=1 to m do

readln(a[i,j]);

writeln('введите точность');

readln(eps);

end;

procedure proverka(Var t:boolean;eps:real;a:matr);

Var sh,j:integer;

Begin

sh:=0;

for j:=1 to m do

if abs(a[1,j])<eps then sh:=sh+1;

if sh=0 then t:=true

else p:=false;

end;

procedure proverka1(Var p:boolean;a:matr);

Var sh,j:integer;

Begin

sh:=0;

for j:=1 to m do

if a[1,j]=0 then sh:=sh+1;

if sh=0 then p:=true

else p:=false;

end;

procedure delenie(Var a:matr);

Var j:integer;

Begin

for j:=1 to m do

a[n,j]:=a[n,j]/a[1,j];

end;

procedure sortirovka(Var a:matr;j:integer);

Var i,k,nom:integer;

max,p:real;

Begin

for i:=1 to (n-1) do

Begin

max:=a[i,j];

nom:=i;

for k:=(i+1) to n do

if a[k,j]>max then

Begin

max:=a[k,j];

nom:=k;

end;

p:=a[i,j];a[i,j]:=a[nom,j];a[nom,j]:=p;

end;

end;

begin

end.

program Z433_1;

uses Z433_1;

const n=3;m=5;

Begin {основная программа}

clrscr;

vvod(a,eps);

for j:=1 to m do

sortirovka(a,j);

proverka(t,eps,a);

if t=true then

Begin

proverka1(p,a);

if p=true then

Begin

delenie(a);

for i:=1 to n do

for j:=1 to m do

write(a[i,j]:3:1,' ');

end

else writeln('в полученной 1 строке есть нулевые элементы');

end else

writeln('в полученной 1 строке есть элементы по мод.< eps');

repeat until keypressed;

end.

2 Если первая строка прямоугольной матрицы имеет максимальное количество отрицательных элементов, проверить, как изменится среднее арифметическое всей матрицы, если заменить все отрицательные элементы их модулями.

program z433_2;

uses z433_2;

Var A:matr;

L:inmass;

i,j:integer;

s1,s2:real;

BEGIN

for i := 1 to n do

for j := 1 to m do

readln(A[i,j]);

Negative(A,L);

if Maximum(L) then

Begin

s1 := SrArifm(A);

write('Среднее арифметическое исходной матрицы: ');

writeln(s1:5:3);

Replacement(A);

s2 := SrArifm(A);

write('Среднее арифметическое положительно определенной матрицы: ');

writeln(s2:5:3);

write('Разность: ');

writeln((s2 - s1):5:3)

end;

readln;

END.

Unit Z433_2;

interface

Const n = 3; m = 4;

Type matr = array[1..n,1..m] of real;

inmass = array[1..n] of integer;

procedure Negative(A:matr; Var L:inmass); {записывает в целочисленный массив L количество отрицательных элементов по строкам}

function Maximum(L:inmass):boolean; {возвращает true, если L[1] - максимален}

function SrArifm(A:matr):real; {возвращает среднее арифметическое матрицы}

procedure Replacement(Var A:matr); {меняет все отрицательные элементы матрицы их модулями}

implementation

procedure Negative(A:matr; Var L:inmass);

Var i,j,k:integer;

Begin

for i := 1 to n do

Begin

k := 0;

for j := 1 to m do

if A[i,j] < 0 then k := k + 1;

L[i] := k;

end;

end; {Negative}

function Maximum(L:inmass):boolean;

Var i:integer;

b:boolean;

Begin

b := true;

i := 1;

repeat i := i + 1;

if L[i] > L[1] then b := false

until (i >= n) or (not b);

Maximum := b;

end; {Maximum}

function SrArifm(A:matr):real;

Var s:real;

i,j:integer;

Begin

s := 0;

for i := 1 to n do

for j := 1 to m do

s := s + A[i,j];

SrArifm := s / (m * n);

end; {SrArifm}

procedure Replacement(Var A:matr);

Var i,j:integer;

Begin

for i := 1 to n do

for j := 1 to m do

if A[i,j] < 0 then A[i,j] := abs(A[i,j]);

end; {Replacement}

begin

END.

3 Если в прямоугольной матрице все суммы элементов строк

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

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

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

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.