| Madoka | Дата: Воскресенье, 31.05.2015, 08:23 | Сообщение # 1 |
|
Рядовой
Группа: Пользователи
Сообщений: 1
Статус: Offline
| uses crt;
const nmax=6;
type matr=array[1..nmax,1..nmax] of integer;
mas=array[1..nmax] of integer;
procedure Vvod(var mt:matr;x,y:byte);
var i,j:byte;
begin
for i:=1 to x do
for j:=1 to y do
mt[i,j]:=random(50)-20;
end;
procedure Vyvod(var mt:matr;x,y:byte);
var i,j:byte;
begin
for i:=1 to x do
begin
for j:=1 to y do
write(mt[i,j]:5);
writeln;
end;
end;
function Max(mt:matr;x,y:byte):integer;{поиск макс}
var i,j:byte;
mx:integer;
begin
mx:=mt[1,1];
for i:=1 to x do
for j:=1 to y do
if mt[i,j]>mx then mx:=mt[i,j];
Max:=mx;
end;
procedure Vector(mt:matr;x:byte;var v:mas);{создание вектора}
var i:byte;
begin
writeln('Вектор элементов главной диагонали матрицы B:');
for i:=1 to x do
begin
v:=mt[i,i];
write(v:4);
end;
writeln;
writeln;
end;
procedure Vstv(var mt:matr;x:byte; var y:byte;v:mas);{вставка столбца-вектора}
var i,j,k:byte;
begin
y:=y+1;
for j:=y downto 3 do
for i:=1 to x do
mt[i,j]:=mt[i,j-1];
for i:=1 to x do
mt[i,2]:=v;
end;
procedure Udal(var mt:matr;var x:byte;y:byte);{удаление строк по условию}
var i,j,k,l:byte;
begin
k:=0;
i:=x;{начинаем с конца, чтобы не изменились индексы}
while i>=1 do
if mt[i,i]<0 then
begin
k:=1;
for l:=i to x-1 do
for j:=1 to y do
mt[l,j]:=mt[l+1,j];
x:=x-1;
i:=i-1;
end
else i:=i-1;
if k=0 then writeln('На главной диагонали нет отрицательных элементов')
else
begin
writeln('Удаление строк с отрицательным на главной диагонали:');
Vyvod(mt,x,y);
end;
end;
var a,b:matr;
v:mas;
n,m,k:byte;
mxa,mxb:integer;
begin
clrscr;
randomize;
n:=nmax;
k:=nmax;
m:=nmax-1;
Vvod(a,n,m);
Vvod(b,n,k);
writeln('Исходная матрица А:');
Vyvod(a,n,m);
mxa:=Max(a,n,m);
writeln('Максимальный=',mxa);
writeln('Исходная матрица B:');
Vyvod(b,n,k);
mxb:=Max(b,n,k);
writeln('Максимальный=',mxb);
if mxa>mxb then
begin
writeln('Максимальный элемент матрицы А больше:');
Vector(b,n,v);
Vstv(a,n,m,v);
writeln('Вставка вектора:');
Vyvod(a,n,m);
end
else
begin
writeln('Максимальный элемент матрицы А не больше:');
Udal(b,n,k);
end;
readln
end.
|
| |
| |
| diamFC | Дата: Воскресенье, 31.05.2015, 10:03 | Сообщение # 2 |
|
Полковник
Группа: Администраторы
Сообщений: 207
Статус: Offline
| http://diamfc.ucoz.ru/forum/2-1-1
|
| |
| |
Программа для построения БЛОК-СХЕМ!!!
