Сортировка

Program ShakerSort;
Var A : array[1..1000] of integer;
N,i,j,p : integer;
Min, Max : integer;
Begin
{Определение размера массива A — N) и его заполнение}
…
{сортировка данных}
for i:=1 to n div 2 do
begin
if A[i]>A[i+1] then
begin
Min:=i+1;
Max:=i;
end
else
begin
Min:=i;
Max:=i+1;
end;
for j:=i+2 to n-i+1 do
if A[j]>A[Max] then
Max:=j
else
if A[j]<A[Min] then
Min:=j;
{Обмен элементов}
P:=A[i];
A[i]:=A[min];
A[min]:=P;
if max=i then
max:=min;
P:=A[N-i+1];
A[N-i+1]:=A[max];
A[max]:=P;
end;
{Вывод отсортированного массива A}
…
End. 

Var A,B : array[1..1000] of integer;
N : integer;
Procedure Sliv(p,q : integer); {процедура сливающая массивы}
Var r,i,j,k : integer;
Begin
r:=(p+q) div 2;
i:=p;
j:=r+1;
for k:=p to q do
if (i<=r) and ((j>q) or (a[i]<a[j])) then
begin
b[k]:=a[i];
i:=i+1;
end
else
begin
b[k]:=a[j];
j:=j+1;
end ;
for k:=p to q do
a[k]:=b[k];
End;
Procedure Sort(p,q : integer); {p,q — индексы начала и конца сортируемой части массива}
Begin
if p<q then {массив из одного элемента тривиально упорядочен}
begin
Sort(p,(p+q) div 2);
Sort((p+q) div 2 + 1,q);
Sliv(p,q);
end;
End;
Begin
{Определение размера массива A — N) и его заполнение}
…
{запуск сортирующей процедуры}
Sort(1,N);
{Вывод отсортированного массива A}
…
End. 

Var A,B : array[1..1000] of byte;
C : array[byte] of integer;
N,i : integer;
Begin
{Определение размера массива A (N) и его заполнение}
…
{сортировка данных}
for i:=0 to 255 do
C[i]:=0;
for i:=1 to N do
C[A[i]]:=C[A[i]]+1;
for i:=1 to 255 do
C[i]:=C[i-1]+C[i];
for i:=N downto 1 do
begin
B[C[A[i]]]:=A[i];
C[A[i]]:=C[A[i]]-1; {здесь мы избегаем возможности записи двух одинаковых чисел в одну ячейку}
end;
{Вывод массива B}
…
End. 

const
   MaxN = 1500000;
var
   a: array[1..MaxN] of LongInt;
   n, hs, i: LongInt;

procedure swap(var x, y: LongInt);
var z: LongInt;
begin
   z := x; x := y; y := z;
end;

procedure pushdown(j: LongInt);
var max: LongInt;
begin
    {выбор максимального из трех элемента}
    if (2*j <= hs) and (a[j] < a[2*j])
               then  max := 2*j
               else  max := j;
    if (2*j+1 <= hs) and (a[max] < a[2*j+1])
               then  max := 2*j+1;
    {если свойство (1) не выполняется,
     рекурсивно запускаем процедуру снова}
    if max <> j then begin
                       swap(a[max], a[j]);
                       pushdown(max)
                    end
end;

procedure heapsort;
begin
    hs := n;
    {строим кучу}
    for i := n div 2 downto 1 do
        pushdown(i);
    {постепенно выкидываем из кучи максимальный элемент}
    for i := n downto 2 do
       begin
           swap(a[1], a[i]); {максимальный элемент - в конец кучи}
           dec(hs);    {уменьшаем кучу, одновременно выкидывая
                        из нее максимальный элемент}
           pushdown(1) {для корня после обмена свойство (1) нарушено}
       end
end;

procedure Init;
begin
    {заполняем массив чем нибуть}
end;

procedure Save;
begin
    {Оперируем полученными данными}
end;

begin
    Init;
    heapsort;
    Save;
end.