Форум на Исходниках.RU https://forum.sources.ru Форум на Исходниках.RU Форум на Исходниках.RU https://forum.sources.ru/index.php?showtopic=50914&view=findpost&p=335309 Fri, 09 Apr 2004 20:20:05 +0000 Как упорядочить массив по возрастанию? https://forum.sources.ru/index.php?showtopic=50914&view=findpost&p=335309 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;
]]> romtek Pascal: Структуры данных https://forum.sources.ru/index.php?showtopic=50914&view=findpost&p=335268 Fri, 09 Apr 2004 19:03:27 +0000 Как упорядочить массив по возрастанию? https://forum.sources.ru/index.php?showtopic=50914&view=findpost&p=335268 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 Pascal: Структуры данных https://forum.sources.ru/index.php?showtopic=50914&view=findpost&p=335240 Fri, 09 Apr 2004 18:21:47 +0000 Как упорядочить массив по возрастанию? https://forum.sources.ru/index.php?showtopic=50914&view=findpost&p=335240 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;
]]> romtek Pascal: Структуры данных https://forum.sources.ru/index.php?showtopic=50914&view=findpost&p=335224 Fri, 09 Apr 2004 17:40:10 +0000 Как упорядочить массив по возрастанию? https://forum.sources.ru/index.php?showtopic=50914&view=findpost&p=335224 - Алгоритмы сортировки -

Рассмотрим следующие виды сортировки массива по возрастанию:
  1. метод выбора (SelectionSort)
  2. метод пузырька (BubbleSort)
  3. метод простых вставок (InsertionSort)
  4. метод бинарных вставок (BinaryInsertionSort)
  5. метод Шелла (ShellSort)
  6. метод Уильяма Флойда, бинарных деревьев (HeapSort)
  7. метод фон Неймана, слияний (NeumanSort)
  8. метод быстрой сортировки (QuickSort)
x
Примечание: В рассмотренных методах сортировки берутся массивы, начинающиеся с индекса 0 !
Для начинающихся с 1, нужно изменять коэффициенты в самой процедуре.


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

Это наиболее естественный алгоритм упорядочивания. Допустим, что элементы a0 , ..., ai-1 уже упорядочены, тогда среди оставшихся ai , ..., an-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) Сортировка массива по возрастанию (метод пузырька)

Последовательно просматриваем числа a0 , ..., an-1 находим наименьшее i такое, что ai > ai+1 . Поменять ai и ai+1 местами, возобновить просмотр с элемента ai+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 Pascal: Структуры данных