Дана целочисленная прямоугольная матрица. Определить номер первого из столбцов, содержащих хотя бы один нулевой элемент. Характеристикой строки целочисленной матрицы назовем сумму ее отрицательных четных элементов. Переставляя строки заданной матрицы, расположить их в соответствии с убыванием характеристик — Pascal(Паскаль)

uses crt;
const nmax=20;
var a:array[1..nmax,1..nmax] of integer;
    n,m,i,j,l:byte;
    sm,b:integer;
begin
clrscr;
randomize;
write('Количество строк n=');
readln(n);
write('Количество столбцов m=');
readln(m);
{вычисление сумм в строках и запись их в дополнительный столбец}
for i:=1 to n do
 begin
  sm:=0;
  for j:=1 to m do
   begin
    a[i,j]:=random(20)-9;
    if (a[i,j]<0)and(a[i,j] mod 2=0) then sm:=sm+a[i,j];
   end;
  a[i,m+1]:=sm;
 end;
writeln('Исходный массив:');
writeln('Сумма':(m*5+8));
for i:=1 to n do
 begin
  for j:=1 to m+1 do
  if j=m+1 then write(a[i,j]:8)
  else write(a[i,j]:5);
  writeln;
 end;
{перестановка строк по убыванию сумм(по последнему столбцу)}
for i:=1 to n-1 do
for l:=i+1 to n do
if a[i,m+1]<a[l,m+1] then
for j:=1 to m+1 do
 begin
  b:=a[i,j];
  a[i,j]:=a[l,j];
  a[l,j]:=b;
 end;
writeln('Строки по убыванию сумм:');
writeln('Сумма':(m*5+8));
for i:=1 to n do
 begin
  for j:=1 to m+1 do
  if j=m+1 then write(a[i,j]:8)
  else write(a[i,j]:5);
  writeln;
 end;
readln
end.

Вариант 2

uses crt;
const nmax=20;
type matr=array[1..nmax,1..nmax] of integer;
procedure Vvod(var mt:matr;var x,y:byte);
var i,j:byte;
    sm:integer;
begin
write('Количество строк = ');
readln(x);
write('Количество столбцов = ');
readln(y);
{вычисление сумм в строках и запись их в дополнительный столбец}
for i:=1 to x do
 begin
  sm:=0;
  for j:=1 to y do
   begin
    mt[i,j]:=random(20)-9;
    if (mt[i,j]<0)and(mt[i,j] mod 2=0) then sm:=sm+mt[i,j];
   end;
  mt[i,y+1]:=sm;
 end;
writeln('Исходный массив:');
writeln('Сумма':(y*5+8));
for i:=1 to x do
 begin
  for j:=1 to y+1 do
  if j=y+1 then write(mt[i,j]:8)
  else write(mt[i,j]:5);
  writeln;
 end;
end;
 
procedure Sort(var mt:matr;x,y:byte);
var i,j,l:byte;
    b:integer;
begin
{перестановка строк по убыванию сумм(по последнему столбцу)}
for i:=1 to x-1 do
for l:=i+1 to x do
if mt[i,y+1]<mt[l,y+1] then
for j:=1 to y+1 do
 begin
  b:=mt[i,j];
  mt[i,j]:=mt[l,j];
  mt[l,j]:=b;
 end;
writeln('Строки по убыванию сумм:');
writeln('Сумма':(y*5+8));
for i:=1 to x do
 begin
  for j:=1 to y+1 do
  if j=y+1 then write(mt[i,j]:8)
  else write(mt[i,j]:5);
  writeln;
 end;
end;
 
var a:matr;
    n,m:byte;
begin
clrscr;
randomize;
Vvod(a,n,m);
Sort(a,n,m);
readln
end.

Leave a Comment

40 − 36 =