Как упорядочить массив по возрастанию? , Алгоритмы сортировки

[Romtek]

- Алгоритмы сортировки -

Рассмотрим следующие виды сортировки массива по возрастанию:

1. метод выбора (SelectionSort)
2. метод пузырька (BubbleSort)
3. метод простых вставок (InsertionSort)
4. метод бинарных вставок (BinaryInsertionSort)
5. метод Шелла (ShellSort)
6. метод Уильяма Флойда, бинарных деревьев (HeapSort)
7. метод фон Неймана, слияний (NeumanSort)
8. метод быстрой сортировки (QuickSort)

_x

---

Примечание: В рассмотренных методах сортировки берутся массивы, начинающиеся с индекса 0 !
Для начинающихся с 1, нужно изменять коэффициенты в самой процедуре.

---

1) Сортировка массива по возрастанию методом выбора

Это наиболее естественный алгоритм упорядочивания. Допустим, что элементы a₀ , ..., a_i-1 уже упорядочены, тогда среди оставшихся a_i , ..., a_n-1 находим минимальный элемент и меняем его местами с i-тым элементом. И так далее, пока массив не будет полностью упорядочен.

(*******************************************************
Процедура для сортировки массива.
Принимает:
    *массив значений a с индексами элементов от 0 до N-1
    *число элементов N
*******************************************************)
procedure SelectionSort(var arr : array of Real; const N : Integer);
var
    I   :   Integer;
    J   :   Integer;
    K   :   Integer;
    M   :   Real;
begin
    for i:=1 to N do
    begin
        m:=Arr[i-1];
        k:=i;
        for j:=i to n do
        begin
            if m>Arr[j-1] then
            begin
                m:=Arr[j-1];
                k:=j;
            end;
        end;
        Arr[k-1]:=Arr[i-1];
        Arr[i-1]:=m;
    end;
end;

2) Сортировка массива по возрастанию (метод пузырька)

Последовательно просматриваем числа a₀ , ..., a_n-1 находим наименьшее i такое, что a_i > a_i+1 . Поменять a_i и a_i+1 местами, возобновить просмотр с элемента a_i+1 и т.д. Тем самым наибольшее число передвинется на последнее место. Следующие просмотры начинать опять сначала, уменьшая на единицу количество просматриваемых элементов. Массив будет упорядочен после просмотра, в котором участвовали только первый и второй элементы.

(*******************************************************
Процедура для сортировки массива.
Принимает:
    *массив значений a с индексами элементов от 0 до N-1
    *число элементов N
*******************************************************)
procedure BubbleSort(var Arr : array of Real; const N : Integer);
var
    I   :   Integer;
    J   :   Integer;
    Tmp :   Real;
begin
    for i:=Pred(N) downto 1 do
        for j:=0 to Pred(i) do
            if Arr[j]>=Arr[j+1] then
            begin
                Tmp:=Arr[j];
                Arr[j]:=Arr[j+1];
                Arr[j+1]:=Tmp;
            end;
end;

Сообщение отредактировано: Romtek - 08.10.10, 20:04

[Romtek]

3) Сортировка массива по возрастанию (метод простых вставок)

Последовательно просматриваем a1 , ..., an-1 и каждый новый элемент ai вставляем на подходящее место в уже упорядоченную совокупность ai-1 , ..., a1 . Это место определяется последовательным сравнением ai с упорядоченными элементами a0 , ..., ai-1 .

(*******************************************************
Процедура для сортировки массива.
Принимает:
    *массив значений a с индексами элементов от 0 до N-1
    *число элементов N
*******************************************************)
procedure InsertionSort(var Arr : array of Real; N : Integer);
var
    I   :   Integer;
    J   :   Integer;
    K   :   Integer;
    Tmp :   Real;
begin
    dec(N);
    i:=1;
    repeat
        j:=0;
        repeat
            if Arr[i]<=Arr[j] then
            begin
                k:=i;
                Tmp:=Arr[i];
                repeat
                    Arr[k]:=Arr[k-1];
                    dec(k);
                until not(k>j);
                Arr[j]:=Tmp;
                j:=i;
            end
            else inc(j);
        until not(j<i);
        inc(i);
    until not(i<=n);
end;

В связи с многочисленными просьбами добавляю реализацию метода простых вставок без циклов с пост-условием:

procedure InsertionSort(var Arr: array of real; n: integer);
var
    i, j: integer;
    T: real;
begin
    for i := 0 to n - 1 do begin
        T := Arr[i];
        j := i - 1;
 
        while (j >= 0) and (T < Arr[j]) do begin
            Arr[j + 1] := Arr[j];
            Dec(j);
        end;
 
        Arr[j + 1] := T;
    end;
end;

4) Сортировка массива по возрастанию (метод бинарных вставок)

Этот алгоритм представляет из себя оптимизированную версию предыдущего, отличие заключается в том, что при поиске место, на которое надо вставить элемент ai в уже упорядоченную совокупность a0 , ..., ai-1 , определяется алгоритмом деления пополам (отсюда и название алгоритма "бинарные вставки" здесь понимаем как "вставка делением пополам").

(*******************************************************
Процедура для сортировки массива.
Принимает:
    *массив значений a с индексами элементов от 0 до N-1
    *число элементов N
*******************************************************)
procedure BinaryInsertionSort(var Arr : array of Real; N : Integer);
var
    B,C,E,I,J,K   :   Integer;
    Tmp :   Real;
begin
    i:=2;
    repeat
        b:=1;
        e:=i-1;
        c:=((b+e) div 2);
        while b<>c do
        begin
            if Arr[c-1]>Arr[i-1] then e:=c
            else b:=c;
            c:=((b+e) div 2);
        end;
        if Arr[b-1]<Arr[i-1] then
        begin
            if Arr[i-1]>Arr[e-1]
               then b:=e+1
               else b:=e;
        end;
        k:=i;
        Tmp:=Arr[i-1];
        while k>b do
        begin
            Arr[k-1]:=Arr[k-1-1];
            dec(k)
        end;
        Arr[b-1]:=Tmp;
        inc(i);
    until not(i<=n);
end;

Сообщение отредактировано: volvo877 - 29.04.08, 07:30

[Romtek]

5) Сортировка массива методом Шелла

(*******************************************************
Процедура для сортировки массива.
Принимает:
    *массив значений a с индексами элементов от 0 до N-1
    *число элементов N
*******************************************************)
procedure ShellSort(var Arr : array of Real; N : Integer);
var
    C   :   Boolean;
    E   :   Integer;
    G   :   Integer;
    I   :   Integer;
    J   :   Integer;
    Tmp :   Real;
begin
    N:=N-1;
    g:=((n+1) div 2);
    repeat
        i:=g;
        repeat
            j:=i-g;
            c:=True;
            repeat
                if Arr[j]<=Arr[j+g] then c:=False
                else
                begin
                    Tmp:=Arr[j];
                    Arr[j]:=Arr[j+g];
                    Arr[j+g]:=Tmp;
                end;
                dec(j)
            until not((j>=0)and(C));
            inc(i)
        until not(i<=n);
        g:=g div 2;
    until not(g>0);
end;

6) Сортировка массива по возрастанию (метод Уильяма Флойда, бинарных деревьев)

Алгоритм основан на представлении массива в виде бинарного дерева, обладающего особыми свойствами. В памяти компьютера все элементы массива расположены последовательно, структура же дерева определяется следующим образом: будем считать, что i-ый элемент массива ("предок") имеет два элемента потомка с номерами 2i+1 и 2i+2. Дерево имеет нормальную форму, если любой элемент предок больше своих потомков.

Из свойств алгоритма стоит заметить, что он дает стабильно хорошую скорость упорядочивания (порядка n*log(n)), вне зависимости от того с каким массивом работает, и поэтому используется в случаях когда необходимо гарантировано упорядочить массив за короткое время.

(*******************************************************
Процедура для сортировки массива.
Принимает:
    *массив значений a с индексами элементов от 0 до N-1
    *число элементов N
*******************************************************)
procedure HeapSort(var Arr : array of Real; N : Integer);
var
    I,J,K,T   :   Integer;
    Tmp :   Real;
begin
    i:=2;
    repeat
        t:=i;
        while t<>1 do
        begin
            k:=t div 2;
            if Arr[k-1]>=Arr[t-1] then t:=1
            else
            begin
                Tmp:=Arr[k-1];
                Arr[k-1]:=Arr[t-1];
                Arr[t-1]:=Tmp;
                t:=k;
            end;
        end;
        inc(i)
    until not(i<=n);
    i:=n-1;
    repeat
        Tmp:=Arr[i];
        Arr[i]:=Arr[0];
        Arr[0]:=Tmp;
        t:=1;
        while t<>0 do
        begin
            k:=2*t;
            if k>i then t:=0
            else
            begin
                if k<i then
                   if Arr[k]>Arr[k-1] then inc(k);
                if Arr[t-1]>=Arr[k-1] then t:=0
                else
                begin
                    Tmp:=Arr[k-1];
                    Arr[k-1]:=Arr[t-1];
                    Arr[t-1]:=Tmp;
                    t:=k;
                end;
            end;
        end;
        dec(i)
    until not(i>=1);
end;

[Romtek]

7) Сортировка массива по возрастанию (метод фон Неймана, слияний)

Алгоритм фон Неймана упорядочивания массива (алгоритм сортировки слияниями) основан на многократных слияниях уже упорядоченных групп элементов массива. Вначале весь массив рассматривается как совокупность упорядоченных групп по одному элементу в каждой. Слиянием соседних групп получаем упорядоченные группы, каждая из которых содержит два элемента (кроме, возможно, последней группы которой не нашлось парной). Далее, упорядоченные группы укрупняются тем же способом и т.д.

Алгоритм дает хорошие показатели по скорости работы, даже в сравнении с сортировкой методом бинарных деревьев. Единственный недостаток - необходимость использовать дополнительный массив того же размера.

(*******************************************************
Процедура для сортировки массива.
Принимает:
    *массив значений a с индексами элементов от 0 до N-1
    *число элементов N
*******************************************************)
procedure NeumanSort(var Arr : array of Real; N : Integer);
type
    PTArr = ^TArr;
    TArr = array[0 .. pred(maxint div sizeof(real))] of real;
var
    C           :   Boolean;
    I,I1,I2,
    N1,N2,J,K   :   Integer;
    Tmp         :   Real;
    BArr        :   PTArr;
    MergeLen    :   Integer;
begin
    GetMem(BArr, (N - 1) * sizeof(real));
 
    MergeLen:=1;
    c:=True;
    while MergeLen<n do
    begin
        if C then
        begin
            i:=0;
            while i+MergeLen<=n do
            begin
                i1:=i+1;
                i2:=i+MergeLen+1;
                n1:=i+MergeLen;
                n2:=i+2*MergeLen;
                if n2>n then n2:=n;
                while (i1<=n1)or (i2<=n2) do
                begin
                    if i1>n1 then
                    begin
                        while i2<=n2 do
                        begin
                            inc(i);
                            BArr^[i-1]:=Arr[i2-1];
                            i2:=i2+1
                        end;
                    end
                    else
                    begin
                        if i2>n2 then
                        begin
                            while i1<=n1 do
                            begin
                                inc(i);
                                BArr^[i-1]:=Arr[i1-1];
                                i1:=i1+1
                            end;
                        end
                        else
                        begin
                            if Arr[i1-1]>Arr[i2-1] then
                            begin
                                inc(i);
                                BArr^[i-1]:=Arr[i2-1];
                                i2:=i2+1
                            end
                            else
                            begin
                                inc(i);
                                BArr^[i-1]:=Arr[i1-1];
                                i1:=i1+1
                            end;
                        end;
                    end;
                end;
            end;
            i:=i+1;
            while i<=n do
            begin
                BArr^[i-1]:=Arr[i-1];
                inc(i);
            end;
        end
        else
        begin
            i:=0;
            while i+MergeLen<=n do
            begin
                i1:=i+1;
                i2:=i+MergeLen+1;
                n1:=i+MergeLen;
                n2:=i+2*MergeLen;
                if n2>n then n2:=n;
                while (i1<=n1)or (i2<=n2) do
                begin
                    if i1>n1 then
                    begin
                        while i2<=n2 do
                        begin
                            inc(i);
                            Arr[i-1]:=BArr^[i2-1];
                            i2:=i2+1
                        end;
                    end
                    else
                    begin
                        if i2>n2 then
                            while i1<=n1 do
                            begin
                                inc(i);
                                Arr[i-1]:=BArr^[i1-1];
                                i1:=i1+1
                            end
                        else
                        begin
                            if BArr^[i1-1]>BArr^[i2-1] then
                            begin
                                inc(i);
                                Arr[i-1]:=BArr^[i2-1];
                                i2:=i2+1
                            end
                            else
                            begin
                                inc(i);
                                Arr[i-1]:=BArr^[i1-1];
                                i1:=i1+1
                            end;
                        end;
                    end;
                end;
            end;
            inc(i);
            while i<=n do
            begin
                Arr[i-1]:=BArr^[i-1];
                inc(i);
            end;
        end;
        MergeLen:=2*MergeLen;
        c:=not(C);
    end;
    if not(C) then
    begin
        i:=1;
        repeat
            Arr[i-1]:=BArr^[i-1];
            inc(i);
        until not(i<=n);
    end;
 
    FreeMem(BArr, (N - 1) * sizeof(real));
end;

8) Сортировка массива по возрастанию (метод быстрой сортировки)

procedure QuickSort(var A: Array of word; L, R: Integer);
var
  I, J: Integer;
  P, T: Word;
begin
  repeat
    I := L;
    J := R;
    P := A[(L + R) shr 1];
    repeat
      while A[I]< P do
        Inc(I);
      while A[J]> P do
        Dec(J);
      if I <= J then
      begin
        T := A[I];
        A[I] := A[J];
        A[J] := T;
        Inc(I);
        Dec(J);
      end;
    until I > J;
    if L < J then
      QuickSort(A, L, J);
    L := I;
  until I >= R;
end;

Сообщение отредактировано: volvo877 - 18.12.08, 08:49