Автор: asdfg

asdfg — Mon, 13 Sep 2021 15:31:29 +0000

type
  aoi = array [1..10, 1..10] of integer;

var
  a: aoi;
  m, n, i, j: integer;

procedure SortCols(var a: aoi; m, n: integer);
var
  i, j, x, v: integer;
begin
  for i := 1 to n do
    for j := i to n do // сортировка пузырьком
    begin
      if a[1, j] < a[1, i] then // если в первой строке элемент столбца меньше 
      begin 
        for x := 1 to m do // с 1ой по последнюю строку
        begin
          v := a[x, j];
          a[x, j] := a[x, i]; 
          a[x, i] := v;       //меняем их местами
        end;
      end
      else if (a[1, j] = a[1, i]) and (i <> j) and (2 <= m) then //если в 1й
      begin //строке элементы одинаковые,и это не один и тот же столбец, и 
      // 2ая строка существует
        if a[2, j] < a[2, i] then //сравниваем элементы тех же столбцов 2й строки
        begin // если меньше 
          for x := 1 to m do //с 1 по последнюю строку меняем столбцы местами 
          begin
            v := a[x, j];
            a[x, j] := a[x, i];
            a[x, i] := v;
          end;
        end
        else if (a[2, j] = a[2, i]) and (3 <= m) then //если они равны и 
        //существует 3я строка
        begin
          if a[3, j] < a[3, i] then // сравниваем те же столбцы по 3й строке
          begin // если меньше
            for x := 1 to m do // с 1 по последнюю строку меняем столбцы местами
            begin
              v := a[x, j];
              a[x, j] := a[x, i];
              a[x, i] := v;
            end;
          end
        end;
      end;
    end;
end;

begin
  writeln ('M:');
  readln(m);
  writeln ('N:');
  readln(n);
  writeln ('A:');
  for i := 1 to m do
    for j := 1 to n do read(a[i, j]); // ввод
  SortCols(a, m, n);                  // процедура
  for i:=1 to m do
  begin
    for j:=1 to n do write (a[i,j],' '); //вывод
    writeln;
    end;
end.

type

aoi = array [1..10, 1..10] of integer;

var

a: aoi;

m, n, i, j: integer;

procedure SortCols(var a: aoi; m, n: integer);

var

i, j, x, v: integer;

begin

for i := 1 to n do

for j := i to n do // сортировка пузырьком

begin

if a[1, j] < a[1, i] then // если в первой строке элемент столбца меньше

begin

for x := 1 to m do // с 1ой по последнюю строку

begin

v := a[x, j];

a[x, j] := a[x, i];

a[x, i] := v; //меняем их местами

end;

end

else if (a[1, j] = a[1, i]) and (i <> j) and (2 <= m) then //если в 1й

begin //строке элементы одинаковые,и это не один и тот же столбец, и

// 2ая строка существует

if a[2, j] < a[2, i] then //сравниваем элементы тех же столбцов 2й строки

begin // если меньше

for x := 1 to m do //с 1 по последнюю строку меняем столбцы местами

begin

v := a[x, j];

a[x, j] := a[x, i];

a[x, i] := v;

end;

end

else if (a[2, j] = a[2, i]) and (3 <= m) then //если они равны и

//существует 3я строка

begin

if a[3, j] < a[3, i] then // сравниваем те же столбцы по 3й строке

begin // если меньше

for x := 1 to m do // с 1 по последнюю строку меняем столбцы местами

begin

v := a[x, j];

a[x, j] := a[x, i];

a[x, i] := v;

end;

end

end;

begin

writeln ('M:');

readln(m);

writeln ('N:');

readln(n);

writeln ('A:');

for i := 1 to m do

for j := 1 to n do read(a[i, j]); // ввод

SortCols(a, m, n); // процедура

for i:=1 to m do

begin

for j:=1 to n do write (a[i,j],' '); //вывод

writeln;

end;

end.

Автор: Bronislav

Bronislav — Thu, 01 Nov 2018 21:46:43 +0000

program Param29;//pabc.net

procedure SortCols(a: array[,] of integer);
begin
  var m := a.GetLength(0);
  var n := a.GetLength(1);
  for var k := n - 2 downto 0 do
  begin
    var i := 0;
    var j := 0;
    while (j <= k) and (i <= m - 1) do
    begin
      if a[i, j] > a[i, j + 1] then
      begin
        for var l := 0 to m - 1 do
          Swap(a[l, j], a[l, j + 1]);
        i := 0
      end
      else
      if a[i, j] = a[i, j + 1] then
      begin
        i += 1;
        continue
      end
      else  i := 0;
      j += 1
    end
  end
end;

begin
  var m := 3;
  var n := 6;
  
  var a := MatrRandom(m, n, 0, 9); a.Println;
//  7   2   8   7   4   7
//  1   8   6   8   4   8
//  7   3   9   8   0   6
  SortCols(a);
  Println;
  a.Println;
//  2   4   7   7   7   8
//  8   4   1   8   8   6
//  3   0   7   6   8   9
end.

program Param29;//pabc.net

procedure SortCols(a: array[,] of integer);

begin

var m := a.GetLength(0);

var n := a.GetLength(1);

for var k := n - 2 downto 0 do

begin

var i := 0;

var j := 0;

while (j <= k) and (i <= m - 1) do

begin

if a[i, j] > a[i, j + 1] then

begin

for var l := 0 to m - 1 do

Swap(a[l, j], a[l, j + 1]);

i := 0

end

else

if a[i, j] = a[i, j + 1] then

begin

i += 1;

continue

end

else i := 0;

j += 1

end

end;

begin

var m := 3;

var n := 6;

var a := MatrRandom(m, n, 0, 9); a.Println;

// 7 2 8 7 4 7

// 1 8 6 8 4 8

// 7 3 9 8 0 6

SortCols(a);

Println;

a.Println;

// 2 4 7 7 7 8

// 8 4 1 8 8 6

// 3 0 7 6 8 9

end.

Комментарии: Решаем задачи Абрамян на Паскале. Param29

Автор: asdfg

Автор: Bronislav