Если в прямоугольной матрице все суммы элементов строк
В прямоугольной матрице в каждом столбце поставить на первое место максимальный элемент столбца и, если среди полученных элементов первой строки не окажется элементов, по модулю меньших заданной величины, разделить элементы последней строки на соотвутствующие элементы первой строки.
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.
Если в прямоугольной матрице все суммы элементов строк