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

  • Автор темы Slade
  • Дата начала
S

Slade

Гость
#1
Код:
program Project2;

{$APPTYPE CONSOLE}

uses
SysUtils;

const
mas1: array[1..4,1..4] of integer = ((4,7,1,-7),
(-3,2,-8,9),
(2,3,10,-2),
(0,3,4,6));
type
mas = array [1..10,1..10] of integer;
procedure VVod1 ( a :mas; n,m :byte);
var i,j,o:byte;
begin
write('Vvedit kilkist stovpchikiv=');
readln(m);
write('Vvedit kiskist ryadkiv=');
readln(n);
write('VVedit massiv:');
For i:=1 to m do
begin
For j:=1 to n do
begin
write('a[',i,']=');
readln(a[i,j]);
end;
end;
For i:=1 to m do
begin
For j:=1 to n do
begin
if o<i then writeln;
write(a[i,j]:4);
o:=i;
end;
end;
end;
procedure Vvod2 (a:mas; n,m:byte);
var i,j,o:byte;
begin
write('Vvedit kilkist stovpchikiv=');
readln(m);
write('Vvedit kiskist ryadkiv=');
readln(n);
write('Massiv:');
for i:=1 to m do
begin
for j:=1 to n do
begin
randomize;
a[i,j]:=random(100)-50;
if o<i then writeln;
write(a[i,j]:4);
o:=i;
end;
end;
end;
Procedure Vvod3;
var i,o,j:byte;
a:mas;
begin
writeln('Massiv:');
for i:=1 to 4 do
begin
for j:=1 to 4 do
begin
if o<i then writeln;
a[i,j]:=mas1[i,j];
o:=i;
write(a[i,j]:4);
end;
end;
end;
Procedure Vstavkami (a:mas);
var j,i,n,m,k:byte;
begin
for j:=2 to n do
begin b:=a[j];
k:=j-1;
while (k>=1)and (a[k]>b) do
begin
a[k+1]:=a[k];
dec(k);
end;
a[k]:=b;
end;
end;
Procedure Viborom(a:mas);
var i,j,n,k:byte;
max,b:mas;
begin
for j:=n downto 2 do
begin
max:=a[1];
k:=1;
for i:=2 to j do
if a[i]>max
then
begin
max:=a[i];
k:=i;
end;
b:=a[k];
a[k]:=a[j];
a[j]:=b
writeln(a[i]:4);
end;
end;
Procedure Obmin (b:mas);
var  j,i,n,m:byte;
a:mas;
begin
for j:=2 to n do
begin
for i:=n downto j do
begin
if a[i]<a[i-1]
then
begin
b:=a[i];
a[i]:=a[i-1];
a[i-1]:=b;
writeln(b);
end;
end;
end;
var a:mas;
i,x,j,n,z,m:byte;
begin
writeln('Viberit variant vvedenya massivu:');
writeln('Z klaviaturi');
writeln('Avtomatichno');
writeln('Gotovi dani');
readln(z);
case z of
1: Vvod1(a,m,n);
2: Vvod2(a,m,n);
3: Vvod3;
end;
writeln('Viberit tip sortuvanya:');
writeln('Obminom');
writeln('Viborom');
writeln('Vstavkami');
case x of
1:Viborom;
2:Obmin;
3:Vstavkami;
end;
readln
end.