На языке Pascal
{============СОРТИРОВКА ВКЛЮЧЕНИЕМ=============}
{ процедура сортировки включением }
procedure InsertSort(var a:t_mas;n:t_index);
var i,j: t_index;
x: t_el;
begin
for i:= 2 to n do
begin
x:= a[i];
j:= i-1;
while (x < a[j])and(j >= 1) do
begin
a[j+1]:= a[j];
j:= j-1;
end;
a[j+1]:= x;
end;
end;
{============СОРТИРОВКА ВЫБОРОМ=============}
{ процедура обмена значений }
procedure Swap_el(var a,b:t_el);
var c:t_el;
begin
c:=a;
a:=b;
b:=c;
end;
{ процедура сортировки выбором }
procedure ChoiceSort(var a:t_mas;n:t_index);
var i,j:t_index;
x:t_el;
begin
for i:= 1 to n do
begin
x:= a[i];
for j:= i+1 to n do
if (a[j] < x) then
x:= a[j];
swap_el(a[i],x);
end;
end;
{=================СОРТИРОВКА ОБМЕНОМ================}
{ процедура обмена значений }
procedure Swap_el(var a,b:t_el);
var c:t_el;
begin
c:=a;
a:=b;
b:=c;
end;
{ процедура сортировки обменом }
procedure BblSort(var a:t_mas;n:t_index);
var i,j: t_index;
begin
for i:= 2 to n do
for j:= n downto i do
if (a[j-1] >= a[j]) then
swap_el(a[j-1],a[j]);
end;
{ процедура улучшенной сортировки обменом 1 }
procedure BblSort_improv1(var a:t_mas;n:t_index);
var i,j: t_index;
fl: boolean;
begin
i:= 2;
repeat
fl:= false; //перестановок изначально нет
for j:= n downto i do
if (a[j-1] >= a[j]) then
begin
swap_el(a[j-1],a[j]);
fl:= true; //некоторые элементы переставлены
end;
|
|
i:= i+1;
until (not fl)or(i > n);
end;
{ процедура улучшенной сортировки обменом 2 }
procedure BblSort_improv2(var a:t_mas;n:t_index);
var i,j,k: t_index;
begin
i:= 2;
k:= n+1;
for j:= n downto i do
if (a[j-1] >= a[j]) then
begin
swap_el(a[j-1],a[j]);
k:= j-1; //запоминаем индекс последнего обмененного элемента
end;
i:= k;
until (i > n);
end;
{============СОРТИРОВКА МЕТОДОМ ШЕЛЛА=============}
{ процедура сортировки методом Шелла }
procedure ShellSort(var a:t_mas;n:t_index);
type t_arr = array [1..65520 div sizeof(word)] of word;
var i,j,hh,t,s: t_index;
k: integer;
h: t_arr;
begin
t:= round(ln(n)/ln(3))-1;
if (t < 1) then
t:= 1;
h[t]:= 1;
for k:= t downto 2 do
h[k-1]:= 3*h[k]+1;
for s:= t downto 1 do
begin
hh:= h[s];
for j:= hh+1 to n do
begin
i:= j-hh;
k:= a[j];
while (k <= a[i])and(i > 0) do
begin
a[i+hh]:= a[i];
i:= i-hh;
end;
a[i+hh]:= k;
end;
end;
end;
{============СОРТИРОВКА МЕТОДОМ ХОАРА=============}
{ процедура сортировки методом Хоара }
procedure HoarSort(var a: t_arr; n: integer);
procedure QSort(L,R:integer);
var x,t,i,j:integer;
begin
x:=a[L]; // в качестве разделителя выбираем первый элемент
i:=L;
j:=R;
while i<=j do
begin
while a[i]<x do
inc(i);
while a[j]>x do
dec(j);
if i<=j then
begin
t:=a[i];
a[i]:=a[j];
a[j]:=t;
inc(i);
dec(j);
end;
end;
if L<j then
QSort(L,j);
if i<R then
QSort(i,R);
end;
begin
QSort(1,n);
end;
{=============ПИРАМИДАЛЬНАЯ СОРТИРОВКА==============}
procedure sift(var a:t_mas;L,R:t_index);
var i,j: t_index;
c: t_el;
begin
i:= L;
j:= 2*L;
c:= a[L];
if (j < R)and(a[j] < a[j+1]) then
j:= j+1;
while (j <= R)and(c < a[j]) do
begin
Swap_el(a[i],a[j]);
i:= j;
j:= 2*j;
if (j < R)and(a[j] < a[j+1]) then
j:= j+1;
end;
end;
{ процедура пирамидальной сортировки }
procedure HeapSort(var a:t_mas;n:t_index);
var i,L,R: t_index;
begin
L:= n div 2+1;
R:= n;
while (L > 1) do
begin
L:= L-1;
Sift(a,L,R);
end;
while (R > 1) do
begin
Swap_el(a[1],a[R]);
R:= R-1;
Sift(a,L,R);
end;
end;
Примеры программной реализации алгоритмов сортировки