Примеры программной реализации алгоритмов сортировки на языке 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;