Паскаль. Сортировка двумерного массива методом выбора.

[olosvi]

Требуется отсортировать данный разрез трехмерного массива (тобишь матрицу) методом выбора используя дополнительный массив и проходя непосредственно по его элементам по возрастанию, например было
3 4 0 1
5 7 6 2
1 2 3 0
стало
0 0 1 1
2 2 3 3
4 5 6 7
С дополнительным массивом понятно, перезаписал матрицу в вектор, посортировал, вернул обратно, а вот как сделать проходя непосредственно по матрице хоть убей не пойму, вот с вектором

procedure StraightSort1;
  type TVector = array[1..n*m] of word;
  var B: TVector;
      Min, Max : integer;
      L, R, i, imin, imax, j, f, k : word;
begin
   for f:=1 to p do
       for j:=1 to m do
           for k:=1 to n do
           B[k+(j-1)*n]:=A[f,j,k];
   for j:=1 to m do begin
   L:=1; R:=m*n;
   while L<R do
   begin
      Min:=B[L]; imin:=L;
      Max:=B[L]; imax:=L;
      for i:=L+1 to R do
         if B[i] < Min then
         begin
            Min:=B[i];
            imin:=i;
         end
         else
            if B[i] > Max then
            begin
               Max:=B[i];
               imax:=i;
            end;

      if imin<>L then
      begin
         B[imin]:=B[L];
         B[L]:=Min;
      end;
      if imax<>R then
      begin
         if imax=L then B[imin]:=B[R]
                   else B[imax]:=B[R];
         B[R]:=Max;
      end;
      L:=L+1; R:=R-1;
   end;
   end;
   for j:=1 to m do
       for k:=1 to n do
       A[f,j,k]:=B[k+(j-1)*n];
end;

p - счетчик разрезов
Я понимаю что надо брать минимальный и максимальный из целого массива, ставить их в соответствующие места, но вот реализовать это никак не выходит

[Serge_Bliznykov]

4 5 6 7
С дополнительным массивом понятно, перезаписал матрицу в вектор, посортировал, вернул обратно, а вот как сделать проходя непосредственно по матрице хоть убей не пойму

всё очень просто. для любой пары координат I, J (координат в матрице) очень легко получить индекс K, являющийся индексом в одномерном массиве (векторе). И наоборот, по индексу K елементарно получить I и J.
Поэтому, можно использовать матрицу, пересчитывая координаты в линейные и сравнивать/сортировать используя пересчёт координат.


p.s. могу ошибаться, но у меня вызывает сомнение ваш алгоритм сортировки. Это точно сортировка выбором?

[olosvi]

Точно выбором, нельзя сортировать пересчетом координат, надо идти конкретно по массиву, без никаких превращений индексов

До превращения индексов я тоже дошёл, я вот думал что надо втулить пару переменных для отслеживания перехода на следущий рядок и пару процедур для сменны рядка, но вот чтото никак не получается, а сдавать через 11 дней :с

Саму процедуру сортировки я брал из методички, мне её нужно видоизменить для сортировки матриц тремя путями
1) перевод матрицы в вектор и сортировка (всё просто, взял да копирнул процедуру из методички)
2) превращение индексов представляя в уме матрицу как вектор (не так просто, но тоже ничего)
3) непосредственно идти по матрице (2 недели имею себе мозги и ничего не получается )

Вот прога целиком, кому интересно

unit arr_op;
interface
         const p = 10;
               m = 10;
               n = 10;
         type TMas = array[1..p,1..m,1..n] of byte;
         procedure RandomZapoln(var B:TMas); {Zapolnenie massiva slu4ainimi chislami}
         procedure MasVivod(var B:TMas); {Vivod massiva}
         procedure OtsortZapoln(var B:TMas); {Zapolnenie massiva otsortirovanimi}
         procedure NeotsortZapoln(var B:TMas); {Zapolnenie massiva neotsortirovanimi chislami}
implementation
              uses crt;
procedure RandomZapoln;
          var i,j,k: integer;
begin
     randomize;
     for i:=1 to p do
         for j:=1 to m do
             for k:=1 to n do
             B[i,j,k]:=random(25);
end;
procedure OtsortZapoln;
          var i,j,k: integer;
begin
     for i:=1 to p do
         for j:=1 to m do
             for k:=1 to n do
                 B[i,j,k]:=k;
end;
procedure NeotsortZapoln;
          var i,j,k,f: integer;
begin
     f:=100;
     for i:=1 to p do
         for j:=1 to m do
             for k:=1 to n do begin
                 B[i,j,k]:=f;
                 dec(f);
                 end;
end;
procedure MasVivod;
          var i,j,k: integer;
              c: char;
begin
     for i:=1 to p do begin
         writeln('------------------------------------------------------------');
            for j:=1 to m do begin
                for k:=1 to n do
                write(B[i,j,k]:3,' ');
                writeln;
                end;
     end;
end;
end.

unit count;
interface
type TTime = record
       Hours,
       Minutes,
       Seconds,
       HSeconds: Word;
     end;
function Restime(const STime, FTime: TTime): longint;
implementation
function Restime;
         begin
         ResTime:=360000*(FTime.Hours-STime.Hours)+
                    6000*(FTime.Minutes-STime.Minutes)+
                     100*(FTime.Seconds-STime.Seconds)+
                         (FTime.HSeconds-STime.HSeconds)
         end;
end.

[olosvi]

unit sort;
interface
  uses arr_op;
  {procedure StraightSort3(var A:TMas); {Sortirovka neposredstvenno v massive}
  procedure StraightSort2(var A:Tmas); {Sortirovka s voobrazhaemim vekotrom}
  procedure StraightSort1(var A:TMas); {Sortirovka s vspomogatel'nim massivom}
implementation
  uses crt;
  procedure StraightSort1;
  type TVector = array[1..n*m] of word; {Vspomogatel'nii massiv dlya zapisi matrici}
  var B: TVector;
      Min, Max : integer;
      L, R, i, imin, imax, j, f, k : word;
begin
   for f:=1 to p do {Schetchik pererizov}
       for j:=1 to m do  {Zapis' matrici v vspomogatel'nii massiv}
           for k:=1 to n do
           B[k+(j-1)*n]:=A[f,j,k];
   for f:=1 to p do begin
   for j:=1 to m do begin
   L:=1; R:=m*n; {Sortirovka vspomogatel'nogo massiva}
   while L<R do  {Tak kak nam nado otsortirovat' matricu celikom
                  to berem praviu granicu razmerom m*n}
   begin
      Min:=B[L]; imin:=L;
      Max:=B[L]; imax:=L;
      for i:=L+1 to R do
         if B[i] < Min then
         begin
            Min:=B[i];
            imin:=i;
         end
         else
            if B[i] > Max then
            begin
               Max:=B[i];
               imax:=i;
            end;

      if imin<>L then
      begin
         B[imin]:=B[L];
         B[L]:=Min;
      end;
      if imax<>R then
      begin
         if imax=L then B[imin]:=B[R]
                   else B[imax]:=B[R];
         B[R]:=Max;
      end;
      L:=L+1; R:=R-1;
   end;
   end;
   for j:=1 to m do  {Perepis' vspomogatel'nogo massiva v nachal'nii}
       for k:=1 to n do
       A[f,j,k]:=B[k+(j-1)*n];
   end;
end;
  procedure StraightSort2;
var
  k, R, j, f, i, L, imin, imax, min, max: word;
  B: word;
begin
  for k := 1 to p do begin
          L:=1; R:=m*n;
          while L<R do begin
                min:= A[k, ((L-1) div n) + 1, L]; imin:=L;
                max:= A[k, ((L-1) div n) + 1, L]; imax:=L;
          for i:= L+1 to R do
              if A[k, ((i-1) div n) +1, ((i-1) mod n) + 1] < Min then begin
                 Min:=A[k, ((i-1) div n) +1, ((i-1) mod n) + 1];
                 imin:=i;
              end else
                  if A[k, ((i-1) div n) +1, ((i-1) mod n) + 1]>Max then begin
                     Max:=A[k, ((i-1) div n) +1, ((i-1) mod n) + 1];
                     imax:=i;
                  end;
          if imin<>L then begin
             A[k, ((imin-1) div n) + 1, ((imin-1) mod n) + 1]:= A[k, ((L-1) div n) + 1, ((L-1) mod n) + 1];
             A[k, ((L-1) div n) + 1, ((L-1) mod n) + 1]:= Min;
          end;
          if imax<>R then begin
             if imax=L then A[k, ((imin-1) div n) + 1, ((imin-1) mod n) + 1]:=A[k, ((R-1) div n) + 1, ((R-1) mod n) + 1] else
                            A[k, ((imax-1) div n) + 1, ((imax-1) mod n) + 1]:=A[k, ((R-1) div n) + 1, ((R-1) mod n) + 1];
             A[k,((R-1) div n) +1, ((R-1) mod n) + 1]:= Max;
             end;
          L:=L+1; R:=R-1;
       end;
   end;
end;

{procedure StraightSort3(var a: TMas);
var
   Min, Max : integer;
   s, k, j, x , y, L, R, i, imin, imax,jmin,jmax: word;
Begin
for k:=1 to p do begin
    L:=1; R:=m*n;
    while L<R do begin


end;
end;}
End.

[olosvi]

program coursework;
     uses sort,count,crt,dos,arr_op;
     const kol = 5;
     type mas = array [1..Kol] of string;
     const stor: mas = ('  StraightSort1  ','  StraightSort2   ','  StraightSort3  ','  All Sorts  ','Vyxod');
     var mmas: TMas;
         i,k: byte;
         startTime,FinishTime: TTime;
         Algorithm1_Time, Algorithm2_Time, Algorithm3_Time: longint;
         srt: byte;
procedure PrintMenu(var k: byte);
var kod: char;
begin
clrscr;
k:=1;
gotoxy(4,1);
K :=1;
repeat
  for i:=1 to Kol do
   begin
     if I=K then
      begin
         textbackground(3);
         textcolor(12);
      end
     else
      begin
         textbackground(0);
         textcolor(15)
      end;
     gotoxy(1,i);
     write(stor[i]);
   end;
  repeat
  kod:=readkey;
  until Kod in [#13, #72, #80];
  case Kod of
  #72: begin  K := K-1; if K = 0 then K := Kol;
       end;
  #80: begin K :=K+1;  if K =10 then K := 1; end;
   end;
 until Kod = #13 ;

end;
begin
 repeat
   textbackground(0);
   textcolor(15);
   PrintMenu(K);
   clrscr;
   textbackground(0);
   textcolor(15);
   if k<5 then
    begin
     write('vybran variant ',k); readln;
    end
   else exit;

[olosvi]

   case K of
   1: begin
      writeln('Viberite tip zapolneniya massiva');
      writeln('1 - random, 2 - otsortirovanii, 3 - neotsortirovanii');
      readln(srt);
      case srt of
      1: RandomZapoln(mmas);
      2: OtsortZapoln(mmas);
      3: NeotsortZapoln(mmas);
      end;
      MasVivod(mmas);
      with StartTime do
      GetTime(Hours, Minutes, Seconds, HSeconds);
      StraightSort1(mmas);
      with FinishTime do
      GetTime(Hours, Minutes, Seconds, HSeconds);
      MasVivod(mmas);
      Algorithm1_Time:= ResTime(StartTime, FinishTime);
      writeln('Time of working of 1 algorithm: ',Algorithm1_Time);
      readln;
      end;
   2: begin
      writeln('Vvedite tip zapolneniya massiva');
      writeln('1 - random, 2 - otsortirovanii, 3 - neotsortirovanii');
      readln(srt);
      case srt of
      1: RandomZapoln(mmas);
      2: OtsortZapoln(mmas);
      3: NeotsortZapoln(mmas);
      end;
      masvivod(mmas);
      with StartTime do
      GetTime(Hours, Minutes, Seconds, HSeconds);
      StraightSort2(mmas);
      with FinishTime do
      GetTime(Hours, Minutes, Seconds, HSeconds);
      masvivod(mmas);
      Algorithm2_Time:= ResTime(StartTime, FinishTime);
      writeln('Time of working of 2 algorithm: ',Algorithm2_Time);
      readln;
      end;
   3: begin
      end;
   4: begin
      writeln('Vvedite tip zapoleniya massiva');
      writeln('1 - random, 2 - otsortirovanii, 3 - neotsortirovanii');
      readln(srt);
      case srt of
      1: begin
         RandomZapoln(mmas);
         MasVivod(mmas);
         with StartTime do
         GetTime(Hours, Minutes, Seconds, HSeconds);
         StraightSort1(mmas);
         with FinishTime do
         GetTime(Hours, Minutes, Seconds, HSeconds);
         MasVivod(mmas);
         Algorithm1_Time:= ResTime(StartTime, FinishTime);
         RandomZapoln(mmas);
         MasVivod(mmas);
         with StartTime do
         GetTime(Hours, Minutes, Seconds, HSeconds);
         StraightSort2(mmas);
         with FinishTime do
         GetTime(Hours, Minutes, Seconds, HSeconds);
         MasVivod(mmas);
         Algorithm2_Time:= ResTime(StartTime, FinishTime);
         writeln('| StraightSort1 | StraightSort2 | StraightSort3 |');
         writeln('-------------------------------------------------');
         writeln('|',Algorithm1_Time:15,'|',Algorithm2_Time:15,'|',Algorithm3_Time:15,'|');
         readln;
         end;
      2: begin
              OtsortZapoln(mmas);
              MasVivod(mmas);
              with StartTime do
              GetTime(Hours, Minutes, Seconds, HSeconds);
              StraightSort1(mmas);
              with FinishTime do
              GetTime(Hours, Minutes, Seconds, HSeconds);
              MasVivod(mmas);
              Algorithm1_Time:= ResTime(StartTime, FinishTime);
              OtsortZapoln(mmas);
              MasVivod(mmas);
              with StartTime do
              GetTime(Hours, Minutes, Seconds, HSeconds);
              StraightSort2(mmas);
              with FinishTime do
              GetTime(Hours, Minutes, Seconds, HSeconds);
              MasVivod(mmas);
              Algorithm2_Time:= ResTime(StartTime, FinishTime);
              MasVivod(mmas);
              writeln('| StraightSort1 | StraightSort2 | StraightSort3 |');
              writeln('-------------------------------------------------');
              writeln('|',Algorithm1_Time:15,'|',Algorithm2_Time:15,'|',Algorithm3_Time:15,'|');
              readln;
              end;
      3: begin
              NeotsortZapoln(mmas);
              MasVivod(mmas);
              with StartTime do
              GetTime(Hours, Minutes, Seconds, HSeconds);
              StraightSort1(mmas);
              with FinishTime do
              GetTime(Hours, Minutes, Seconds, HSeconds);
              MasVivod(mmas);
              Algorithm1_Time:= ResTime(StartTime, FinishTime);
              NeotsortZapoln(mmas);
              MasVivod(mmas);
              StraightSort2(mmas);
              MasVivod(mmas);
              writeln('| StraightSort1 | StraightSort2 | StraightSort3 |');
              writeln('-------------------------------------------------');
              writeln('|',Algorithm1_Time:15,'|',Algorithm2_Time:15,'|',Algorithm3_Time:15,'|');
              readln;
              end;
   end;
end;
end;
 until k = 5;
end.

[olosvi]

Если кому интересно, то я сделал непосредственный обход по массиву, вот

procedure StraightSort3(var a: TMas);
var
   Min, Max, L, R: integer;
   k, j, jR , jL, iL, iR, i, imin, imax,jmin,jmax,xL,yL,xR,yR: word;
Begin
for k:=1 to p do begin
    iL:=0; jL:=1;
    iR:=m+1; jR:=n;
    L:=1; R:=m*n;
    while L<R do begin
          if (L-1) mod n = 0 then inc(iL);
          if (R+1) mod n = 1 then dec(iR);
          Min:=A[k,iL,jL]; imin:=iL; jmin:=jL;
          Max:=A[k,iL,jL]; imax:=iL; jmax:=jL;
          if jL=n then begin
             xL:=iL+1;
             yL:=1;
             end else begin
                 xL:=iL;
                 yL:=jL+1;
             end;
          if jR=1 then begin
             xR:=iR-1;
             yR:=n;
             end else begin
             xR:=iR;
             yR:=jR-1;
             end;
             for i:=L to R do begin
                     if (A[k,xL,yL]<Min) then
                          begin
                          Min:=A[k,xL,yL];
                          jMin:=yL;
                          iMin:=xL;
                          end
                     else
                     if (A[k,xR,yR]>Max) then
                     begin
                          Max:=A[k,xR,yR];
                          jMax:=yR;
                          iMax:=xR;
                     end;
                     if yL=n then begin yL:=1; xL:=xL+1; end else yL:=yL+1;
                     if yR=1 then begin yR:=n; xR:=xR-1; end else yR:=yR-1;
                     end;
          if (jmin<>jL) or ((jmin=jL) and (imin<>iL)) then
          begin
               A[k,imin,jmin]:=A[k,iL,jL];
               A[k,iL,jL]:=Min;
          end;
          if (jmax<>jR) or ((jmax=jR) and (imax<>iR)) then
          begin
               if (jmax=jL) and (imax=iL) then A[k,imin,jmin]:=A[k,iR,jR]
               else A[k,imax,jmax]:=A[k,iR,jR];
               A[k,iR,jR]:=Max;
          end;
          inc(jL);
          if jL>n then jL:=1;
          dec(jR);
          if jR<1 then jR:=n;
          L:=L+1; R:=R-1;
end;
end;
end;