На главную
ПРАВИЛА FAQ Помощь Участники Календарь Избранное DigiMania RSS
msm.ru
! Правила ЧаВО (FAQ) разделов Паскаля
В этом разделе разрешено создавать только темы, в которых описано РЕШЕНИЕ какой-либо общей проблемы, или описание какого-либо аспекта языка Паскаль.
Обсуждение уже созданных тем разрешено, но только конструктивное, например указание на ошибку или уточнение имеющегося текста.

Стоит почитать Структуры данных
Модераторы: volvo877, Romtek
  
> Как упорядочить массив по возрастанию?, Алгоритмы сортировки
    - Алгоритмы сортировки -


    Рассмотрим следующие виды сортировки массива по возрастанию:
    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-тым элементом. И так далее, пока массив не будет полностью упорядочен.

    ExpandedWrap disabled
      (*******************************************************
      Процедура для сортировки массива.
      Принимает:
          *массив значений 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 и т.д. Тем самым наибольшее число передвинется на последнее место. Следующие просмотры начинать опять сначала, уменьшая на единицу количество просматриваемых элементов. Массив будет упорядочен после просмотра, в котором участвовали только первый и второй элементы.



    ExpandedWrap disabled
      (*******************************************************
      Процедура для сортировки массива.
      Принимает:
          *массив значений 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 -
      3) Сортировка массива по возрастанию (метод простых вставок)

      Последовательно просматриваем a1 , ..., an-1 и каждый новый элемент ai вставляем на подходящее место в уже упорядоченную совокупность ai-1 , ..., a1 . Это место определяется последовательным сравнением ai с упорядоченными элементами a0 , ..., ai-1 .
      ExpandedWrap disabled
        (*******************************************************
        Процедура для сортировки массива.
        Принимает:
            *массив значений 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;


      В связи с многочисленными просьбами добавляю реализацию метода простых вставок без циклов с пост-условием:
      ExpandedWrap disabled
        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 , определяется алгоритмом деления пополам (отсюда и название алгоритма "бинарные вставки" здесь понимаем как "вставка делением пополам").
      ExpandedWrap disabled
        (*******************************************************
        Процедура для сортировки массива.
        Принимает:
            *массив значений 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 -
        5) Сортировка массива методом Шелла

        ExpandedWrap disabled
          (*******************************************************
          Процедура для сортировки массива.
          Принимает:
              *массив значений 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)), вне зависимости от того с каким массивом работает, и поэтому используется в случаях когда необходимо гарантировано упорядочить массив за короткое время.
        ExpandedWrap disabled
          (*******************************************************
          Процедура для сортировки массива.
          Принимает:
              *массив значений 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;
          7) Сортировка массива по возрастанию (метод фон Неймана, слияний)

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

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

          ExpandedWrap disabled
            (*******************************************************
            Процедура для сортировки массива.
            Принимает:
                *массив значений 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) Сортировка массива по возрастанию (метод быстрой сортировки)

          ExpandedWrap disabled
            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 -
          0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
          0 пользователей:


          Рейтинг@Mail.ru
          [ Script Execution time: 0,1243 ]   [ 18 queries used ]   [ Generated: 19.07.19, 04:34 GMT ]