Правила форума
Прочтите прежде чем задавать вопрос!
Вот прога.
Program sortirovka;
const
n=15;
type
mas=array[-9..n] of integer;
var
a:mas;
i,j:integer;
Procedure puzirkovaya(a:mas);
var
y,x,i,j:integer;
Begin
y:=0;
for i:=2 to n do
for j:=n downto i do begin
y:=y+1;
if a[j-1]>a[j] then begin
x:=a[j-1];
a[j-1]:=a[j];
a[j]:=x;
end;
end;
writeln('Puzirkovaya sortirovka');
for i:=1 to n do write(a[i]:5);
writeln;
writeln('Chislo sravnenii:',y);
End;
Procedure Sheikernaya(a:mas);
var
l,r,k,j,y,x:integer;
Begin
l:=2;
r:=n;
k:=n;
repeat
for j:=r downto l do begin
y:=y+1;
if a[j-1]>a[j] then begin
x:=a[j-1];
a[j-1]:=a[j];
a[j]:=x;
k:=j;
end;
end;
l:=k+1;
for j:=l to r do begin
y:=y+1;
if a[j-1]>a[j] then begin
x:=a[j-1];
a[j-1]:=a[j];
a[j]:=x;
k:=j;
end;
end;
r:=k-1;
Until l>r;
writeln('Sheikernaya sortirovka');
for i:=1 to n do write(a[i]:5);
writeln;
writeln('Chislo sravnenii:',y);
End;
Procedure sortirovka_vstavkami(a:mas);
var
i,x,y,j:integer;
Begin
for i:=2 to n do begin
x:=a[i];
a[0]:=x;
j:=i;
y:=y+1;
while x<a[j-1] do begin
y:=y+1;
a[j]:=a[j-1];
j:=j-1;
end;
a[j]:=x;
end;
writeln('Sortirovka vstavkami');
for i:=1 to n do write(a[i]:5);
writeln;
writeln('Chislo sravnenii:',y);
End;
Procedure binarnie_vstavki(a:mas);
var
i,j,y,l,m,r,x:integer;
Begin
for i:=2 to n do begin
y:=y+1;
x:=a[i];
l:=1;
r:=i;
while l<r do begin
m:=(l+r) div 2;
if a[m]<=x then l:=m+1
else r:=m;
end;
for j:=i downto r+1 do a[j]:=a[j-1];
a[r]:=x;
end;
writeln('Sortirovka binarnimi vstavkami');
for i:=1 to n do write(a[i]:5);
writeln;
writeln('Chislo sravnenii:',y);
End;
Procedure pryamoi_vibor(a:mas);
var
i,j,x,y,k:integer;
Begin
for i:=1 to n do begin
k:=i;
x:=a[i];
y:=y+1;
for j:=i+1 to n do
if a[j]<x then begin
k:=j;
x:=a[k];
end;
a[k]:=a[i];
a[i]:=x;
end;
writeln('Sortirovka s pomoschiu pryamogo vibora');
for i:=1 to n do write(a[i]:5);
writeln;
writeln('Chislo sravnenii:',y);
End;
Procedure Shella(a:mas);
var
i,j,m,x,y:integer;
Begin
m:=n;
while m>=1 do begin
m:=m div 2;
y:=y+1;
for i:=m+1 to n do begin
x:=a[i];
j:=i-m;
while (j>=1) and (x<a[j]) do begin
a[j+m]:=a[j];
j:=j-m;
end;
a[j+m]:=x;
end;
end;
writeln('Sortirovka Shella');
for i:=1 to n do write(a[i]:5);
writeln;
writeln('Chislo sravnenii:',y);
End;
Procedure Shella2(a:mas);
const
h:array [1..4] of integer=(9,5,3,1);
var
i,j,k,s,y,x:integer;
m:1..4;
Begin
for m:=1 to 4 do begin
k:=h[m];
s:=-k;
y:=y+1;
for i:=k+1 to n do begin
x:=a[i];
j:=i-k;
if s=0 then s:=-k;
s:=s+1;
a[s]:=x;
while x<a[j] do begin
a[j+k]:=a[j];
j:=j-k;
end;
a[j+k]:=x;
end;
end;
writeln('Sortirovka Shella s zadannoi posledovatelnostui shagov');
for i:=1 to n do write(a[i]:5);
writeln;
writeln('Chislo sravnenii:',y);
End;
Procedure Xoara(a:mas);
const
m=12;
var
i,j,l,r,y:integer;
x,w:integer;
s:0..m;
stack:array [1..m] of record
l,r:integer;
end;
Begin
s:=1;
stack[s].l:=1;
stack[s].r:=n;
repeat
l:=stack[s].l;
r:=stack[s].r;
s:=s-1;
repeat
i:=l;
j:=r;
x:=a[(l+r) div 2];
repeat
while a[i]<x do i:=i+1;
while x<a[j] do j:=j-1;
if i<=j then begin
w:=a[i];
a[i]:=a[j];
a[j]:=w;
i:=i+1;
j:=j-1;
end;
until i>j;
if i<r then begin
s:=s+1;
stack[s].l:=i;
stack[s].r:=r;
end;
r:=j;
until l>=r;
until s=0;
writeln('Sortirovka Xoara');
for i:=1 to n do write(a[i]:5);
writeln;
writeln('Chislo sravnenii:',y);
End;
Begin
randomize;
writeln('Isxodnii massiv:');
for i:=1 to n do begin
a[i]:=random(50)-25;
write(a[i]:5);
end;
writeln;
puzirkovaya(a);
Sheikernaya(a);
sortirovka_vstavkami(a);
binarnie_vstavki(a);
pryamoi_vibor(a);
Shella(a);
Shella2(a);
Xoara(a);
readln;
End.
Ты что, решил, что специально для тебя я тут буду распинаться второй раз на ту же тему? Ошибаешься...