end
end;
procedure vstavka;
var
k,d:byte;
begin
if nevozrast = 'y' then
if po_stolb = 'y' then
begin
for k:=1 to m do
for i:=2 to n do
begin
d:=a[i,k];
j:=i-1;
while (d>a[j,k]) and (j>0) do
begin
a[j+1,k]:=a[j,k];
j:=j-1
end;
a[j+1,k]:=d
end
end
else
begin
for k:=1 to n do
for i:=2 to m do
begin
d:=a[k,i];
j:=i - 1;
while (d>a[k,j]) and (j>0) do
begin
a[k,j+1]:=a[k,j];
j:=j-1
end;
a[k,j+1]:=d
end
end
else
if po_stolb = 'y' then
begin
for k:=1 to m do
for i:=2 to n do
begin
d:=a[i,k];
j:=i-1;
while (d<a[j,k]) and (j>0) do
begin
a[j+1,k]:=a[j,k];
j:=j-1
end;
a[j+1,k]:=d
end
end
else
begin
for k:=1 to n do
for i:=2 to m do
begin
d:=a[k,i];
j:=i-1;
while (d<a[k,j]) and (j>0) do
begin
a[k,j+1]:=a[k,j];
j:=j-1
end;
a[k,j+1]:=d
end
end
end;
procedure obmen;
var
k:byte;
buf:byte;
begin
if nevozrast = 'y' then
if po_stolb = 'y' then
begin
for k:=1 to m do
for i:=1 to n-1 do
for j:=1 to n-i do
if a[j+1,k]>a[j,k] then
begin
buf:=a[j+1,k];
a[j,k]:=a[i,k];
a[j+1,k]:=buf
end
end
else
begin
for k:=1 to n do
for i:=1 to m-1 do
for j:=1 to m-i do
if a[k,j+1]>a[k,j] then
begin
buf:=a[k,j+1];
a[k,j]:=a[k,i];
a[k,j+1]:=buf
end
end
else
if po_stolb = 'y' then
begin
for k:=1 to m do
for i:=1 to n-1 do
for j:=1 to n-i do
if a[j+1,k]<a[j,k] then
begin
buf:=a[j+1,k];
a[j,k]:=a[i,k];
a[j+1,k]:=buf
end
end
else
begin
for k:=1 to n do
for i:=1 to m-1 do
for j:=1 to m-i do
if a[k,j+1]<a[k,j] then
begin
buf:=a[k,j+1];
a[k,j]:=a[k,i];
a[k,j+1]:=buf
end
end
end;
end.
Программа, использующий модуль:
program lab_20;
uses crt, modul;
var
type
mas = array[1..20,1..20] of byte;
var
a: mas;
i,j,n,m: byte;
sposob: 1..4;
nevozrast, po_stolb: char;
begin
clrscr;
writeln('введите число строк');
readln(n);
writeln('введите число столбцов');
readln(m);
writeln('введите элементы массива:');
for i:=1 to n do
for j:=1 to m do
readln(a[i,j]);
writeln('сортировка не по возрастанию?(y/n)');
readln(nevozrast);
writeln('сортировка по столбцам?(y/n)');
readln(po_stolb);
writeln('способ сортировки');
writeln('1 - дробинка');
writeln('2 – дробинка с флагом');
writeln('3 - вставка');
writeln('4 - обмен');
readln(sposob);
clrscr;
writeln('исходный массив:');
for i:=1 to n do
begin
for j:=1 to m do
write(a[i,j]:4);
writeln;
end;
writeln('сортировка не по возрастанию: ', nevozrast);
writeln('сортировка по столбцам: ', po_stolb);
case sposob of
1:drob(n,m,a,nevozrast, po_stolb);
2:drobflag(n,m,a,nevozrast, po_stolb);
3:vstavka(n,m,a,nevozrast, po_stolb);
4:obmen(n,m,a,nevozrast, po_stolb);
end;
writeln('отсортированный массив:');
for i:=1 to n do
begin
for j:=1 to m do
write(a[i,j]:4);
writeln;
end;
readln
end.
Результат прогона программы:
Уважаемый посетитель!
Чтобы распечатать файл, скачайте его (в формате Word).
Ссылка на скачивание - внизу страницы.