Сортировка двумерных массивов

Отсортировать элементы двумерного массива по элементам второй строки.

Исходный массив. Результат

1 2 3 4 5 5 2 4 3 1

9 3 7 3 1 1 3 3 7 9

6 7 8 9 1 1 7 9 8 6

От сортировки одномерного массива этот случай отличается только тем, что переставлять нужно не два сравниваемых элемента, а два столбца:

for i: = 1 to n – 1 do

for j: = i+1 to n do

if a [2, i] > a [2, j]

then for k: = 1 to n do

begin r: = a [k, i]; a [k, i]; = a[k, j]; a [k, j]: =r

end.

{Сортировка массивов}

{ 1. Вставками }

{ 2. Обменом }

{ 3. Выбором }

{ 4. Фон Неймана (Слияние двух отсортированных массивов)}

program sor1;

uses crt;

const n=4;

var mas:array[1..n,1..n]of integer;

buf,l,i,j,a,c,nextmas:integer;

quit:boolean;

procedure print;

begin

for i:=1 to n do

begin

for j:=1 to n do

write(' ',mas[i,j],' ');

writeln;

end;

writeln;writeln('Ќ ¦ЁвҐ Enter ¤«п Їа®¤®«¦Ґ­Ёп !');

readln;

end;

procedure next;

begin

j:=j+1;

if j=n+1 then begin j:=1;i:=i+1;end;

end;

procedure last;

begin

j:=j-1;

if j=0 then begin j:=n;i:=i-1;end;

end;

begin

clrscr;

for i:=1 to n do

for j:=1 to n do

mas[i,j]:=round(random*(9));

print;

i:=1;j:=1;

for l:=2 to (n*n) do

begin

next;buf:=mas[i,j];a:=i;c:=j;

last;quit:=true;

while (buf<mas[i,j])and(quit) do

begin

nextmas:=mas[i,j];

mas[i,j]:=buf;

next;mas[i,j]:=nextmas;last;last;

if j=0 then quit:=false;

end;

i:=a;j:=c;

end;

print;

end.

Результаты работы:

program sor2;

uses crt;

const n=4;

var mas:array[1..n,1..n]of integer;

buf,l,units,i,j,nextmas:integer;

quit:boolean;

procedure print;

begin

for i:=1 to n do

begin

for j:=1 to n do

write(' ',mas[i,j],' ');

writeln;

end;

writeln;writeln('Ќ ¦ЁвҐ Enter ¤«п Їа®¤®«¦Ґ­Ёп !');

readln;

end;

procedure next;

begin

j:=j+1;

if j=n+1 then begin j:=1;i:=i+1;end;

end;

procedure last;

begin

j:=j-1;

if j=0 then begin j:=n;i:=i-1;end;

end;

begin

clrscr;

units:=n*n;

for i:=1 to n do

for j:=1 to n do

mas[i,j]:=round(random*9);

print;

repeat

i:=1;j:=1;

quit:=true;

units:=units-1;

for l:=1 to units do

begin

next;nextmas:=mas[i,j];last;

if mas[i,j]>nextmas

then begin buf:=mas[i,j];mas[i,j]:=nextmas;next;mas[i,j]:=buf;quit:=false;end

else next;

end;

until quit or (units=1);

print;

end.

Результаты работы:

program sor3;

uses crt;

const n=4;

var mas:array[1..n,1..n]of integer;

min,buf,l,l1,i,j,i1,j1,a,c:integer;

procedure print;

begin

for i:=1 to n do

begin

for j:=1 to n do

write(' ',mas[i,j],' ');

writeln;

end;

writeln;writeln('Ќ ¦ЁвҐ Enter ¤«п Їа®¤®«¦Ґ­Ёп !');

readln;

end;

begin

clrscr;

for i:=1 to n do

for j:=1 to n do

mas[i,j]:=round(random*9);

print;

a:=1;c:=1;i:=1;j:=1;

for l:=1 to (n*n) do

begin

min:=mas[a,c];i:=a;j:=c;i1:=a;j1:=c;

for l1:=1 to (n*n+1)-l do

begin

if min>mas[i1,j1] then begin min:=mas[i1,j1];i:=i1;j:=j1;end;

j1:=j1+1;if j1=(n+1) then begin j1:=1;i1:=i1+1;end;

end;

buf:=mas[i,j];

mas[i,j]:=mas[a,c];

mas[a,c]:=buf;

c:=c+1;if c=(n+1) then begin c:=1;a:=a+1;end;

end;

print;

end.

Результаты работы:

program sor4;

uses crt;

const n=4;

type mas=array[1..n,1..n]of integer;

var mas1,mas2:mas;

mas3:array[1..2*n,1..n]of integer;

buf,i,j,i1,j1,a,c:integer;

procedure next(t:integer);

begin

if t=1 then begin

j:=j+1;if j=n+1 then begin j:=1;i:=i+1;end;

end;

if t=2 then begin

j1:=j1+1;if j1=n+1 then begin j1:=1;i1:=i1+1;end;

end;

if t=3 then begin

c:=c+1;if c=n+1 then begin c:=1;a:=a+1;end;

end;

end;

procedure print(pr:mas);

begin

for a:=1 to n do

begin

for c:=1 to n do

write(' ',pr[a,c],' ');

writeln;

end;

writeln;writeln('Ќ ¦ЁвҐ Enter ¤«п Їа®¤®«¦Ґ­Ёп !');

readln;

end;

begin

clrscr;

buf:=10;

for a:=1 to n do

for c:=1 to n do

begin

mas1[a,c]:=buf;

buf:=buf+1;

mas2[a,c]:=buf;

buf:=buf+1;

end;

print(mas1);print(mas2);

a:=1;c:=1;i:=1;j:=1;i1:=1;j1:=1;

while (i<>n+1)and(i1<>n+1) do

begin

if mas1[i,j]<mas2[i1,j1] then begin mas3[a,c]:=mas1[i,j];next(1);end

else begin mas3[a,c]:=mas2[i1,j1];next(2);end;

next(3);

end;

if i=n+1 then while not(i1=n+1)do

begin

mas3[a,c]:=mas2[i1,j1];

next(3);next(2);

end;

if i1=n+1 then while not(i=n+1)do

begin

mas3[a,c]:=mas2[i,j];

next(3);next(1);

end;

for a:=1 to n*2 do

begin

for c:=1 to n do

write(' ',mas3[a,c],' ');

writeln;

end;

writeln;writeln('Ќ ¦ЁвҐ Enter ¤«п Їа®¤®«¦Ґ­Ёп !');

readln;

end.

Результаты работы: