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

Previous  Top  Next

    
 

 

Code:

{ **** UBPFD *********** by kladovka.net.ru ****

>> Быстрый алгоритм сортировки больших массивов

 

Сортировка вариантного массива методом Шелла.

 

Зависимости: Variants

Автор:       Delirium, Master_BRAIN@beep.ru, ICQ:118395746, Москва

Copyright:   Delirium (Master BRAIN)

Дата:        4 июня 2002 г.

********************************************** }

 

procedure Sorting(Down:boolean;var Data:Variant);

Var Skach,m,n:integer;

   St:boolean;

   Tmp:Variant;

begin

Skach:=VarArrayHighBound(Data,1)-1;

While Skach>0 do

begin

Skach:=Skach div 2;

repeat

St:=True;

for m:=0 to VarArrayHighBound(Data,1)-1-Skach do

  begin

  n:=m+Skach;

  if ( Down and (Data[n]<Data[m]) )

  or ( (not Down) and (Data[n]>Data[m]) ) then

   begin

   Tmp:=Data[m];

   Data[m]:=Data[n];

   Data[n]:=Tmp;

   St:=False;

   end;

  end;

until St;

end;

end;

 

 

 

 

Пример использования:

Code:

procedure TForm1.Button1Click(Sender: TObject);

var A:Variant;

   i:integer;

begin

A:=VarArrayCreate([0, Memo1.Lines.Count-1], varVariant);

for i:=0 to Memo1.Lines.Count-1 do A[i]:=Memo1.Lines.Strings[i];

Sorting(True,A);

for i:=0 to Memo1.Lines.Count-1 do Memo1.Lines.Strings[i]:=A[i];

end;

©Drkb::04160


 

Code:

{ **** UBPFD *********** by kladovka.net.ru ****

>> Сортировка различными методами

 

Сортировка одномерного массива значений типа Double методами:

4) Сортировка Шелла (ShellSort);

 

Зависимости: Math

Автор:       iZEN, izen@mail.ru

Copyright:   адаптация для Delphi

Дата:        14 сентября 2004 г.

********************************************** }

 

{ Сортировка ShellSort }

procedure ShellSort(var data: array of double);

var

lo, hi, i, j, incr: Integer;

t: double;

begin

lo := Low(data);//минимальный индекс массива

hi := High(data);//максимальный индекс массива

incr := hi div 2; // начальный инкремент

while (incr > lo)

do begin

    i := incr;

    while (i <= hi)

    do begin // Внутренний цикл простых вставок

       j := i - incr;

       while (j > lo - 1)

       do if (data[j] > data[j+incr])

          then begin

               t := data[j];

               data[j] := data[j+incr];

               data[j+incr] := t;

               j := j - incr;

               end

          else j := lo - 1;//Останов

       Inc(i);

       end;

    incr := incr div 2;

    end;

end;

©Drkb::04161


 

Соpтиpовка Шелла. Это еще одна модификация пyзыpьковой соp- тиpовки. Сyть ее состоит в том, что здесь выполняется сpавнение ключей, отстоящих один от дpyгого на некотоpом pасстоянии d. Ис- ходный pазмеp d обычно выбиpается соизмеpимым с половиной общего pазмеpа соpтиpyемой последовательности. Выполняется пyзыpьковая соpтиpовка с интеpвалом сpавнения d. Затем величина d yменьшается вдвое и вновь выполняется пyзыpьковая соpтиpовка, далее d yмень- шается еще вдвое и т.д. Последняя пyзыpьковая соpтиpовка выполня- ется пpи d=1. Качественный поpядок соpтиpовки Шелла остается O(N^2), сpеднее же число сpавнений, опpеделенное эмпиpическим пy- тем - log2(N)^2*N. Ускоpение достигается за счет того, что выяв- ленные "не на месте" элементы пpи d>1, быстpее "всплывают" на свои места.

 

Пpимеp иллюстpиpyет соpтиpовкy Шелла.

 

 

Code:

{===== Пpогpаммный пpимеp =====}

{ Соpтиpовка Шелла }

Procedure Sort( var a : seq);

Var d, i, t : integer;

   k : boolean; { пpизнак пеpестановки }

  begin

  d:=N div 2{ начальное значение интеpвала }

 

  while d>0 do begin { цикл с yменьшением интеpвала до 1 }

 

    { пyзыpьковая соpтиpовка с интеpвалом d }

    k:=true;

    while k do begin { цикл, пока есть пеpестановки }

      k:=false; i:=1;

      for i:=1 to N-d do begin

        { сpавнение эл-тов на интеpвале d }

        if a[i]>a[i+d] then begin

          t:=a[i]; a[i]:=a[i+d]; a[i+d]:=t; { пеpестановка }

          k:=true;  { пpизнак пеpестановки }

          end; { if ... }

        end; { for ... }

      end; { while k }

    d:=d div 2{ yменьшение интеpвала }

    end{ while d>0 }

end;

©Drkb::04162

http://delphiworld.narod.ru/

DelphiWorld 6.0

 

 


Code:

{

The following procedure sorts an Array with the

fast Shell-Sort algorithm.

Invented by Donald Shell in 1959,

the shell sort is the most efficient of the O(n2)

class of sorting algorithms

}

 

 

Procedure Sort_Shell(var a: array of Word);

var

  bis, i, j, k: LongInt;

  h: Word;

begin

  bis := High(a);

  k := bis shr 1;// div 2

while k > 0 do

  begin

    for i := 0 to bis - k do

    begin

      j := i;

      while (j >= 0) and (a[j] > a[j + k]) do

      begin

        h := a[j];

        a[j] := a[j + k];

        a[j + k] := h;

        if j > k then

          Dec(j, k)

        else

          j := 0;

      end; // {end while]

   end; // { end for}

   k := k shr 1; // div 2

end// {end while}

 

end;

 

©Drkb::04163

Взято с сайта: http://www.swissdelphicenter.ch