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

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

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.

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

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.

 

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

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

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

Определить столбец прямоугольной матрицы с максимальной

Суммой элементов и, если его номер больше заданного,

Сформировать матрицу из стобцов исходной до найденного

Столбца, иначе сформировать массив из элементов

Заданного столбца.

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.

 

 

Главной диагонали.

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.

 

Если все точки плоскости, заданные своими координатами, попадают в круг с радиусом 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.

 

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

program Z433_17;

uses Z433_17;

Var a:matr;

max,min,eps:real;

i,j:integer;

Begin

for i:=1 to n do

for j:=1 to t do

readln(a[i,j]);

readln(eps);

max(a,max);

min(a,min);

if abs(max-min)<eps then Begin

for i:=1 to n do

for j:=1 to t do

if a[i,j]<0

then a[i,j]:=abs(a[i,j]); end;

for i:=1 to n do

for j:=1 to t do

writeln(a[i,j]);

end.

 

 

unit Z433_17;

interface

Const n=5;

Const m=6;

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

procedure max(a:matr;Var max:real);

procedure min(a:matr;Var min:real);

implementation

procedure max(a:matr;Var max:real);

Var i,j:integer;

Begin

for i:=1 to n do

for j:=1 to m do

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

for i:=1 to n do

for j:=1 to m do

if a[i,j]<0 and abs(a[i,j])<max

then max:=abs(a[i,j]);

end;

procedure min(a:matr;Var min:real);

Var i,j:integer;

Begin

for i:=1 to n do

for j:=1 to m do

if a[i,j]>0 then min:=a[i,j];

for i:=1 to n do

for j:=1 to t do

if a[i,j]>0 and abs(a[i,j])<min

then min:=abs(a[i,j]);

end;

end.

 

18 Определить по экзаменациооной ведомости попадает ли группа на конкурс лучших групп. Условие конкурса: средний балл группы выше четырех, отсутствие неуспевающих, число студентов не имеющих тройки больше половины всех студентов группы

 

program Z433_18;

uses Z433_18;

Var A: matr;

sum, sr_bal: real;

T: vector;

k, i, j, kol: integer;

Begin {осн. программы}

For i:=1 to n do

For j:=1 to m do

readln(A[i,j]);

Bal(A,sum, sr_bal);

USPEVAEMOST(A, k);

TROIKI(A, T, kol);

If (sr_bal>4) and (k=0) and

(kol>(m/2)) then writeln('Gruppa_popadaet')

else writeln('ne_popadaet');

end.

 

Unit Z433_18;

interface

Const n=3; m=4;

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

vector=array [1..m] of integer;

Var A: matr;

sum, sr_bal: real;

T: vector;

k, i, j, kol: integer;

Procedure BAL(A: matr; Var sum, sr_bal: real);

Procedure USPEVAEMOST(A: matr; Var k: integer);

Procedure TROIKI(A:matr; Var T:vector; Var kol: integer);

implementation

Procedure BAL(A: matr; Var sum, sr_bal: real);

Var i, j: integer;

Begin

sum:=0;

sr_bal:=0;

For i:=1 to n do

For j:=1 to m do

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

sr_bal:=sum/(n*m);

end;

Procedure USPEVAEMOST(A: matr; Var k: integer);

Var i, j: integer;

Begin

k:=0;

For i:=1 to n do

For j:=1 to m do

If A[i, j]<3 then k:=k+1

end;

Procedure TROIKI(A:matr; Var T:vector; Var kol: integer);

Var i, j: integer;

Begin

kol:=0;

For i:=1 to n do

For j:=1 to m do

If A[i,j]>3 then T[j]:=1 else T[j]:=0;

For j:=1 to m do

If T[j]=1 then kol:=kol+1

end;

end.

 

Подсчитать как изменится среднее арифметическое элементов матрицы, если во всех столбац с номерами, большими, чем номер столбца с максимальным количеством отрицательных элементов, заменить все отрицательные элементы по их модулям.

 

Unit Z433_19;

interface

Const n=5;

Type

Matr = array [1..n,1..n] of real;

Var p,i,j: integer; V,A:matr; w: string; r,sr1,sr2:real;

Procedure SrAr (A:matr; Var sr:real);

Procedure nomer (A:matr; Var P:integer);

Procedure Zamena(P:integer; A:matr; Var V:matr);

Procedure Pods4et (sr1,sr2:real;Var w:string; Var r:real);

implementation

Procedure SrAr (A:matr; Var sr:real);

Var i,j: integer;

Begin

For i:=1 to n do

For j:=1 to n do

Sr:=sr+A[i,j];

Sr:=sr/sqr(n);

End; { Procedure SrAr }

Procedure nomer (A:matr; Var P:integer);

Var Z,B, i,j: integer;

Begin

For i:=1 to n do

If A[i,1]<0 then

Begin

Z:=z+1;

P:=1;

End;

For j:=2 to n do

Begin

For i:=1 to n do

If A[i,j]<0 then

B:=b+1;

If b>z then

Begin

Z:=b;

P:=j;

End;

End;

End; { Procedure nomer }

Procedure Zamena(P:integer; A:matr; Var V:matr);

Var I,j:integer;

Begin

For j:=1 to n do

If i>n then

For i:=1 to n do

If A[i,j]<0 then

V[i,j]:=abs (A[i,j]);

End; { Procedure Zamena }

Procedure Pods4et (sr1,sr2:real;Var w:string; Var r:real);

Begin

If sr1>sr2 then

Begin

R:=sr1-sr2;

W:='уменьшилось';

End

Else

If sr1<sr2 then

Begin

R:=sr1-sr2;

W:='увелчилось';

End;

End; { Procedure Pods4et }

end.

 

Program Z433_19;

Uses Z433_19;

Var

p,i,j: integer;

V,A:matr;

w: string;

r,sr1,sr2:real;

BEGIN

for i:=1 to n do

for j:=1 to n do

readln(a[i,j]);

SrAr(A,sr1);

Nomer(A,N);

Zamena(N,A,V);

SrAr (A,sr2);

Pods4et(sr1,sr2,w,r);

Writeln (w, 'на', r);

End.

 

 

Дана квадратная матрица. Если номер столбца с максимальной суммой элементов совпадает с номером строки с максимальной суммой элементов, определить сумму найденных элементов строки и столбца, иначе - распечатать номера найденных строки и столбца с максимальными суммами.

 

unit Z433_22;

interface

Const n=5;

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

massiv=array[1..n]of real;

procedure colmax(a:matriza;Var ncol:integer;Var sumcol:massiv;Var maxcol:real);

procedure rowmax(a:matriza;Var nrow:integer;Var sumrow:massiv;Var maxrow:real);

procedure summa(a:matriza;ncol:integer;nrow:integer;Var sumelem:real);

implementation

procedure colmax(a:matriza;Var ncol:integer;Var sumcol:massiv;Var maxcol:real);

Var i,j:integer;

Begin

for j:=1 to n do Begin

sumcol[j]:=0;

for i:=1 to n do

sumcol[j]:=sumcol[j]+a[i,j]; end;

maxcol:=sumcol[1];

for j:=2 to n do

if sumcol[j]>maxcol then Begin

maxcol:=sumcol[j];

ncol:=j; end;

end; { procedure colmax }

procedure rowmax(a:matriza;Var nrow:integer;Var sumrow:massiv;Var maxrow:real);

Var i,j:integer;

Begin

for i:=1 to n do Begin

sumrow[i]:=0;

for j:=1 to n do

sumrow[i]:=sumrow[i]+a[i,j]; end;

maxrow:=sumrow[1];

for i:=2 to n do

if sumrow[i]>maxrow then Begin

maxrow:=sumrow[i];

nrow:=i; end;

end;{ procedure rowmax }

procedure summa(a:matriza;ncol:integer;nrow:integer;Var sumelem:real);

Var i,j:integer;

Begin

sumelem:=0;

for i:=1 to n do

for j:=1 to n do

if (i=nrow) or (j=ncol)

then sumelem:=sumelem+a[i,j];

end; { procedure summa }

end.

 

program Z433_22;

uses Z433_22;

Var a:matriza;

sumcol,sumrow:massiv;

sumelem,maxcol,maxrow:real;

ncol,nrow,i,j:integer;

Begin

for i:=1 to n do

for j:=1 to n do

readln(a[i,j]);

colmax(a,ncol,sumcol,maxcol);

rowmax(a,nrow,sumrow,maxrow);

if ncol=nrow then Begin

summa(a,ncol,nrow,sumelem);

writeln(sumelem); end

else writeln(nrow,ncol);

end.

 

23 program Z433_23;

uses Z433_23;

Var x,y:mass; t:boolean; z:mass1;

i:integer;

Begin{osnovnaya programma}

writeln('x[i]=');

for i:=1 to n do

readln(x[i]);

writeln('y[i]=');

for i:=1 to n do

readln(y[i]);

ysl(x,y,t);

if t then Begin

form_massiv(x,y,z);

for i:=1 to n do

writeln (z[i]);

end

else writeln('yslovie ne vupolneno');

end.

 

 

unit Z433_23;

interface;

Const n=2;

Type mass=array[1..n] of integer;

mass1=array[1..n] of real;

function fact(n:integer):integer;

procedure ysl(x,y:mass; Var t:boolean);

procedure form_massiv(x,y:mass; Var z:mass1);

implementation

function fact(n:integer):integer;

Var y,i:integer;

Begin y:=1;

for i:=1 to n do

y:=y*i;

fact:=y;

end;

procedure ysl(x,y:mass; Var t:boolean);

Var i:integer;

Begin

for i:=1 to n do

if (y[i]>x[i]) then t:=true

else t:=false;

end;

procedure form_massiv(x,y:mass; Var z:mass1);

Var i:integer;

Begin

for i:=1 to n do

z[i]:=fact(y[i])/(fact(x[i])*(fact(y[i])-fact(x[i])));

end;

end.

 

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

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.

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

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.

 

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