В матрице удалить строки с несколькими максимумами и столбцы с заданной суммой элементов, 2-ю строку отсортировать

Приветствую всех форумчан и случайно заглянувших в эту тему! Ребят, огромная просьба помочь в написании программы на Turbo Pascal (работал в ней классе в 8, но сейчас очень тяжело это вспомнить, на делфи еще что-то могу состряпать, но не в турбо паскале), надеюсь на понимание и огромное спасибо всем откликнувшимся заранее! Задача следующая: Дана квадратная целочисленная матрица порядка n. 1. Удалите строки, содержащие более одного максимального элемента, а затем столбцы, сумма элементов которых равна заданному числу. Если такого столбца или строки нет, то вывести сообщение об этом. 2. Отсортировать элементы второй строки по убыванию. Для отладки программы элементы массива сформировать с помощью генератора случайных чисел
4 ответа

В Delphi с {$APPTYPE Console} результат будет мало отличим от Turbo Pascal...


bormant, Необходимо еще код приложить, а, судя по синтаксису (именно в синтаксис все и упирается), он будет отличим от Turbo Pascal.


Необходимо еще код приложить
Прикладывайте.
по синтаксису (именно в синтаксис все и упирается), он будет отличим от Turbo Pascal
Если будет, поправим. Но вариант, одинаково хороший для обоих, существует.


Плоский вариант
const
  nn=5; W=3;
  m: Integer = nn;
  n: Integer = nn;
var
  a: array [1..nn,1..nn] of Integer;
  i, j, k, t: Integer;
begin
  Randomize;
  for i:=1 to m do for j:=1 to n do a[i,j]:=Random(10);
  WriteLn('A =');
  for i:=1 to m do begin
    for j:=1 to n do Write(a[i,j]:W); WriteLn;
  end;
 
  m:=0;
  for i:=1 to nn do begin
    t:=a[i,1]; for j:=2 to nn do if t<a[i,j] then t:=a[i,j];
    k:=0; for j:=1 to nn do if a[i,j]=t then Inc(k);
    if k=1 then begin
      Inc(m); if m<i then a[m]:=a[i];
    end;
  end;
  if m<nn then begin
    WriteLn('A'' =');
    for i:=1 to m do begin
      for j:=1 to n do Write(a[i,j]:W); WriteLn;
    end;
  end else WriteLn('Нет подходящих строк');
 
  WriteLn('Суммы столбцов:');
  for j:=1 to n do begin
    t:=0; for i:=1 to m do Inc(t,a[i,j]); Write(t:W);
  end; WriteLn;
  Write('Число: '); ReadLn(k);
 
  n:=0;
  for j:=1 to nn do begin
    t:=0; for i:=1 to m do Inc(t,a[i,j]);
    if t<>k then begin
      Inc(n); if n<j then for i:=1 to m do a[i,n]:=a[i,j];
    end;
  end;
  if n<nn then begin
    WriteLn('A'''' =');
    for i:=1 to m do begin
      for j:=1 to n do Write(a[i,j]:W); WriteLn;
    end;
  end else WriteLn('Нет подходящих столбцов');
  
  if m>=2 then begin
    t:=n;
    repeat i:=t; t:=1;
      for j:=1 to i-1 do
        if a[2,j+1]>a[2,j] then begin
          t:=a[2,j+1]; a[2,j+1]:=a[2,j]; a[2,j]:=t; t:=j;
        end;
    until t=1;
    WriteLn('A'''''' =');
    for i:=1 to m do begin
      for j:=1 to n do Write(a[i,j]:W); WriteLn;
    end;
  end else WriteLn('Нет второй строки');
end.
Очевидно, можно избавиться от дублирования кода, где это возможно. За это придется заплатить фиксацией типа матрицы...
Кликните здесь для просмотра всего текста
const
  nn=5; W=3;
type
  TMatrix = array [1..nn,1..nn] of Integer;
 
procedure mWrite(const s: String; a: TMatrix; m, n: Integer);
var i, j: Integer;
begin
  WriteLn(s);
  for i:=1 to m do begin
    for j:=1 to n do Write(a[i,j]:W); WriteLn;
  end;
end;
 
const
  m: Integer = nn; n: Integer = nn;
var
  a: TMatrix;
  i, j, k, t: Integer;
begin
  Randomize;
  for i:=1 to m do for j:=1 to n do a[i,j]:=Random(10);
  mWrite('A =',a,m,n);
 
  m:=0;
  for i:=1 to nn do begin
    t:=a[i,1]; for j:=2 to nn do if t<a[i,j] then t:=a[i,j];
    k:=0; for j:=1 to nn do if a[i,j]=t then Inc(k);
    if k=1 then begin
      Inc(m); if m<i then a[m]:=a[i];
    end;
  end;
  if m<nn then mWrite('A =',a,m,n)
  else WriteLn('Нет подходящих строк');
 
  WriteLn('Суммы столбцов:');
  for j:=1 to n do begin
    t:=0; for i:=1 to m do Inc(t,a[i,j]); Write(t:W);
  end; WriteLn;
  Write('Число: '); ReadLn(k);
 
  n:=0;
  for j:=1 to nn do begin
    t:=0; for i:=1 to m do Inc(t,a[i,j]);
    if t<>k then begin
      Inc(n); if n<j then for i:=1 to m do a[i,n]:=a[i,j];
    end;
  end;
  if n<nn then mWrite('A'''' =',a,m,n)
  else WriteLn('Нет подходящих столбцов');
  
  if m>=2 then begin
    t:=n;
    repeat i:=t; t:=1;
      for j:=1 to i-1 do
        if a[2,j+1]>a[2,j] then begin
          t:=a[2,j+1]; a[2,j+1]:=a[2,j]; a[2,j]:=t; t:=j;
        end;
    until t=1;
    mWrite('A'''''' =',a,m,n);
  end else WriteLn('Нет второй строки');
end.
Можно отдельные задачи оформить в виде процедур.
Кликните здесь для просмотра всего текста
const
  nn=5; W=3;
type
  TMatrix = array [1..nn,1..nn] of Integer;
 
procedure mWrite(const s: String; a: TMatrix; m, n: Integer);
var i, j: Integer;
begin
  WriteLn(s);
  for i:=1 to m do begin
    for j:=1 to n do Write(a[i,j]:W); WriteLn;
  end;
end;
 
procedure mGen(var a: TMatrix; m, n: Integer);
var i, j: Integer;
begin
  for i:=1 to m do for j:=1 to n do a[i,j]:=Random(10);
end;
 
procedure CheckRows(var a: TMatrix; var m: Integer; n: Integer);
var i, j, k, t, tm: Integer;
begin
  tm:=m; m:=0;
  for i:=1 to tm do begin
    t:=a[i,1]; for j:=2 to n do if t<a[i,j] then t:=a[i,j];
    k:=0; for j:=1 to n do if a[i,j]=t then Inc(k);
    if k=1 then begin
      Inc(m); if m<i then a[m]:=a[i];
    end;
  end;
  if m<tm then mWrite('A =',a,m,n)
  else WriteLn('Нет подходящих строк');
end;
 
procedure CheckCols(var a: TMatrix; m: Integer; var n: Integer);
var i, j, k, t, tn: Integer;
begin
  WriteLn('Суммы столбцов:');
  for j:=1 to n do begin
    t:=0; for i:=1 to m do Inc(t,a[i,j]); Write(t:W);
  end; WriteLn;
  Write('Число: '); ReadLn(k);
  tn:=n; n:=0;
  for j:=1 to tn do begin
    t:=0; for i:=1 to m do Inc(t,a[i,j]);
    if t<>k then begin
      Inc(n); if n<j then for i:=1 to m do a[i,n]:=a[i,j];
    end;
  end;
  if n<tn then mWrite('A'''' =',a,m,n)
  else WriteLn('Нет подходящих столбцов');
end;
 
procedure vSortDsc(a: array of Integer; n: Integer);
var i, j, t: Integer;
begin
  t:=n-1;
  repeat i:=t; t:=0;
    for j:=0 to i-1 do
      if a[j+1]>a[j] then begin
        t:=a[j+1]; a[j+1]:=a[j]; a[j]:=t; t:=j;
      end;
  until t=0;
end;
 
procedure mSort2(var a: TMatrix; m, n: Integer);
begin
  if m>=2 then begin
    vSortDsc(a[2],n); mWrite('A'''''' =',a,m,n);
  end else WriteLn('Нет второй строки');
end;
 
const
  m: Integer = nn; n: Integer = nn;
var
  a: TMatrix;
begin
  Randomize;
  mGen(a,m,n); mWrite('A =',a,m,n);
  CheckRows(a,m,n);
  CheckCols(a,m,n);
  mSort2(a,m,n);
end.
От повторного подсчета сумм столбцов легко избавиться:
Кликните здесь для просмотра всего текста
procedure CheckCols(var a: TMatrix; m: Integer; var n: Integer);
var
  i, j, k, t, tn: Integer;
  s: array [1..nn] of Integer;
begin
  WriteLn('Суммы столбцов:');
  for j:=1 to n do begin
    t:=0; for i:=1 to m do Inc(t,a[i,j]); s[j]:=t; Write(t:W);
  end; WriteLn;
  Write('Число: '); ReadLn(k);
  tn:=n; n:=0;
  for j:=1 to tn do begin
    if s[j]<>k then begin
      Inc(n); if n<j then for i:=1 to m do a[i,n]:=a[i,j];
    end;
  end;
  if n<tn then mWrite('A'''' =',a,m,n)
  else WriteLn('Нет подходящих столбцов');
end;