Question

Дана матрица целых чисел размером 5х6. переставить столбцы так,чтобы сумма их элементов убывала

Answer 1

Const
  m = 6;
  n = 9;

type
  R = record
    sum: integer;
    nom: integer
  end;
  vR = array[1..n] of R;
  tm = array[1..m, 1..n] of integer;

function SumCol(a: tm; k: integer): integer;
{ Сумма элементов в k-м столбце (колонке) матрицы а }
var
  i, s: integer;
begin
  s := 0;
  for i := 1 to m do
    s := s + a[i, k];
  SumCol := s
end;

procedure Swp(var a, b: R);
{ Меняет местами элементы a и b }
var
  t: R;
begin
  t := a; a := b; b := t
end;

procedure Shell(var a: vR);
{ сортировка методом Шелла по убыванию }
var
  i, j, step: integer;

begin
  step := n div 2;
  while step > 0 do
  begin
    for j := n - step downto 1 do
    begin
      i := j;
      while i <= n - step do
      begin
        if a[i].sum < a[i + step].sum then Swp(a[i], a[i + step]);
        i := i + step
      end
    end;
    step := step div 2
  end
end;

var
  a, c: tm;
  b: vR;
  i, j: integer;

begin
  Randomize;
  Writeln('*** Исходные элементы массива ***');
  for i := 1 to m do
  begin
    for j := 1 to n do
    begin a[i, j] := Random(101) - 50; Write(a[i, j]:4) end;
    Writeln
  end;
  { формируем вектор сумм по столбцам }
  for j := 1 to n do
  begin
    b[j].sum := SumCol(a, j);
    b[j].nom := j;
  end;
  { сортируем полученный вектор по убыванию сумм }
  Shell(b);
  { осуществляем перестановку во вс массив с}
  for j := 1 to n do
    for i := 1 to m do c[i, j] := a[i, b[j].nom];
  { копируем содержимое вс массива с в массив а }
  Writeln('*** Результирующие элементы массива ***');
  for i := 1 to m do
  begin
    for j := 1 to n do
    begin
      a[i, j] := c[i, j];
      Write(a[i, j]:4)
    end;
    Writeln
  end
end.

Тестовое решение:
*** Исходные элементы массива ***
 -27  13  13 -15   8  27  28  -1  32
  44  36  20 -39  45 -46  29  18  36
 -14 -36  -5  35  36 -14  24  31 -19
 -42 -34 -44  40  50 -21 -17 -30  37
 -38  22 -46   9 -14  42 -10   1  30
  41 -41 -21  21  39 -45  18   4  -3
*** Результирующие элементы массива ***
   8  32  28 -15  -1 -27  13  27  13
  45  36  29 -39  18  44  36 -46  20
  36 -19  24  35  31 -14 -36 -14  -5
  50  37 -17  40 -30 -42 -34 -21 -44
 -14  30 -10   9   1 -38  22  42 -46
  39  -3  18  21   4  41 -41 -45 -21