Дана квадратная матрица. Увеличить все элементы строки с минимальной суммой элементов на среднее арифметическое элементов матрицы, лежащих выше главной диагонали.
Unit Z433_13;
interface
Const n = 3;
Type matr = array[1..n,1..n] of real;
mass = array[1..n] of real;
procedure Sum(A:matr; Var S:mass);
{Записывает в массив S суммы элементов матрицы A по строкам}
procedure Minimum(S:mass; Var k:integer);
{k - номер минимального элемента массива S}
procedure SrArifm(A:matr; Var sr:real);
{sr - среднее арифметическое элементов матрицы, лежащих выше главной диагонали}
procedure Increase(k:integer; sr:real; Var A:matr);
{Увеличивает элементы k-й строки матрицы на величину sr}
implementation
procedure Sum(A:matr; Var S:mass);
Var i,j:integer;
Begin
for i := 1 to n do
Begin
S[i] := 0;
for j := 1 to n do
S[i] := S[i] + A[i,j];
end;
end; { procedure Sum }
procedure Minimum(S:mass; Var k:integer);
Var i:integer;
min:real;
Begin
min := S[1];
k := 1;
for i := 2 to n do
if S[i] < min then
Begin
min := S[i];
k := i;
end;
end; { procedure Minimum }
procedure SrArifm(A:matr; Var sr:real);
Var i,j,k:integer;
Begin
k := (n * n - n) div 2;
sr := 0;
for i := 1 to n do
for j := 1 to n do
if j > i then sr := sr + A[i,j];
sr := sr / k;
end; { procedure SrArifm }
procedure Increase(k:integer; sr:real; Var A:matr);
Var j:integer;
Begin
for j := 1 to n do
A[k,j] := A[k,j] + sr;
end; { procedure Increase }
END.
program z433_13;
uses Z433_13;
Var A:matr;
S:mass;
i,j,k:integer;
sr:real;
BEGIN
for i := 1 to n do
for j := 1 to n do
readln(A[i,j]);
Sum(A,S);
Minimum(S,k);
SrArifm(A,sr);
Increase(k,sr,A);
for i := 1 to n do
Begin
for j := 1 to n do
write(A[i,j]:5:3,' ');
writeln;
end;
END.
Изменить заданную прямоугольную матрицу так, чтобы
На первом месте стояла строка с максимальной, а на
Последнем месте строка с минимальной суммой элементов,
Сохранив все элементы исходной матрицы.
program z433_14;
uses Z433_14;
const n=3; m=4;
BEGIN
writeln('Введите матрицу');
for i:=1 to n do
for j:=1 to m do
readln( a[i,j]);
max(a,k);
min(a,b);
zamena(k,a);
for i:=1 to n do
begin
for j:=1 to m do
write(A[i,j]:0:1,' ' );
writeln;
end;
END.
Unit Z433_14;
const n=3; m=4;
type matr=array[1..n,1..m] of real;
var a:matr;b,k,i,j:integer;
Procedure max(var a:matr;var k:integer);
procedure min(var a:matr; var k:integer);
procedure zamena(k:integer;var a:matr);
implementation
Procedure max(var a:matr;var k:integer);
var t,sum:real;
begin
sum:=0; t:=0;
for i:=1 to n do
begin
for j:=1 to m do
sum:=sum+a[i,j];
if sum>t then begin t:=sum;k:=i;end;
sum:=0;
end;
end;
procedure min(var a:matr; var k:integer);
var b,sum:real;
begin
sum:= 0; b:= 0;
for i:= 1 to n do
begin
for j:= 1 to m do sum:=sum+a[i,j];
if sum<b then begin b:=sum; k:=i; end;
sum:=0; end; end;
procedure zamena(k:integer;var a:matr);
var t:real;
begin
for j:=1 to m do begin
t:=a[1,j];
a[1,j]:=a[k,j];
a[k,j]:=t;
end; end; end.
15.Задачка с длинным условием и разными бяками=)
program Z433_15;
uses Z433_15;
Var a:matr;
c:mas;
i,j,k:integer;
sr:real;
Begin
vvodm(a);
k:=0;
sr:=0;
for i:=1 to n-1 do
Begin
for j:=1 to n do c[j]:=a[i,j];
k:=k+chktri(c,i);
end;
vyvodm(a);
if k=0 then
Begin
for i:=1 to n do
Begin
for j:=1 to n do c[j]:=a[i,j];
sr:=sr+sredmas(c);
end;
writeln('Srednee arifmeticheskoe=',sr/n:2:3);
end else writeln('Chislo ne nulevyx=',k);
readln;
end.
Unit Z433_15;
interface
uses crt;
Const n=4;
Type mas= array [1..n] of real;
procedure vvodm(Var a:mas);
procedure vyvodm(a:mas);
function iter(x,e:real):real;
implementation
procedure vvodm;
Var i:integer;
Begin
clrscr;
writeln('Vvod elementov massiva:');
for i:=1 to n do
Begin
write('[',i,']=');
readln(a[i]);
end;
end;
procedure vyvodm;
Var i:integer;
Begin
writeln;
writeln('Soderganie massiva:');
for i:=1 to n do write(a[i]:3:2,' ');
writeln;
end;
function iter;
Var i:integer;
y,y1,y2:real;
Begin
y:=1/x;
repeat
y1:=(3*y/2)-(x*y*y*y/2);
y2:=(3*y1/2)-(x*y1*y1*y1/2);
y:=y1;
until(abs(y1-y2)<=e);
iter:=y2;
end;
end.
end.
Если все заданные точки плоскости принадлежат первой четверти, определить координаты точки, наиболее удаленной от начала коодинат, иначе определить координаты точке, не попавших в первую четверть.
unit Z433_16;
interface
uses crt;
Const n=5;
Type mas=array[1..n] of real;
inmas=array[1..n] of real;
Var x,y:mas;
l:inmas;
k,i,t,c:integer;
procedure check(x,y:mas; k:integer);
procedure coord(x,y:mas;c:integer);
implementation
procedure check(x,y:mas; k:integer);
Begin
k:=0;
for i:=1 to n do
Begin
if (x[i]>0) and (y[i]>0) then k:=k+1
end;
if k=n then t:=1
else
t:=0;
end;
procedure coord(x,y:mas;c:integer);
Begin
if(not(x[i]>0) and (y[i]>0)) then
Begin k:=k+1;
l[k]:=i
end;
end;
end.
program Z433_16;
uses Z433_16;
Var x,y:mas;
l:inmas;
k,i,t,c:integer;
Begin
for i:=1 to n do
Begin
writeln('vvedite kordinati x');
readln(x[i]);
writeln('vvedite koordinati y');
readln(y[i]);
check(x,y,k);
coord(x,y,c);
writeln(t, k, l[k]);
readln;
end;
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.