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.
