Отсортировать по строкам матрицу A от верхнего угла A[1,1] к нижнему углу A[n,m] — Pascal(Паскаль)

const
  n = 5;
  m = 3;
 
var
  a : array [1..n, 1..m] of integer;
 
procedure QSort(lI, lJ, rI, rJ: integer);
var
  x, b : integer;
  iI, iJ, jI, jJ : word;
  xI, xJ, ofs : word;
begin
  writeln(#10, 'Range: ', lI, ':', lJ, ' - ', rI, ':', rJ);
 
  writeln('Offset = ', ((((lI - 1) * m + lJ) + ((rI - 1) * m + rJ)) div 2));
 
  ofs := (((lI - 1) * m + lJ) + ((rI - 1) * m + rJ)) div 2;
  writeln('Offset = ', ofs);
 
  xI := (ofs - 1) div m + 1;
  xJ := (ofs - 1) mod m + 1;
 
  writeln('Middle element: ', xI, ':', xJ);
 
  x := A[xI, xJ];
  writeln('x = ', x);
 
  iI := lI;
  iJ := lJ;
  jI := rI;
  jJ := rJ;
 
  while ((iI - 1) * m + iJ) <= ((jI - 1) * m + jJ) do
   begin
    while a[iI, iJ] < x do
     begin
      inc(iJ);
      if iJ > m then
       begin
        iJ := 1;
        inc(iI);
       end;
     end;
 
    while a[jI, jJ] > x do
     begin
      dec(jJ);
      if jJ < 1 then
       begin
        jJ := m;
        dec(jI);
       end;
     end;
 
    if ((iI - 1) * m + iJ) <= ((jI - 1) * m + jJ) then
     begin
      b := a[iI, iJ];
      a[iI, iJ] := a[jI, jJ];
      a[jI, jJ] := b;
 
      writeln('Swap ', iI, ':', iJ, ' - ', jI, ':', jJ);
      writeln('     ', a[iI, iJ], ' vs ', a[jI, jJ]);
 
      inc(iJ);
      if iJ > m then
       begin
        iJ := 1;
        inc(iI);
       end;
 
      dec(jJ);
      if jJ < 1 then
       begin
        jJ := m;
        dec(jI);
       end;
     end;
   end;
 
  if ((lI - 1) * m + lJ) < ((jI - 1) * m + jJ) then
   QSort(lI, lJ, jI, jJ);
 
  if ((iI - 1) * m + iJ) < ((rI - 1) * m + rJ) then
   QSort(iI, iJ, rI, rJ);
end;
 
var
  i, j: integer;
 
begin
  {main beg}
  randomize;
  writeln('Исходная матрица');
  for i := 1 to n do
   begin
    for j := 1 to m do
     begin
      A[i, j] := random(80);{- 25;}
      {write(a[i, j]:7);}
      write(a[i, j]:3);
     end;
    writeln;
   end;
  writeln;
 
  QSort(1, 1, n, m);
 
  writeln('Преобразованная матрица');
  for i := 1 to n do
  begin
    for j := 1 to m do write(a[i, j]:7);
    writeln;
  end;
  {main end}
end.

Leave a Comment

94 − = 85