shell.pas

Implementations of different methods of sorting: BinaryInsertions.pas BubbleSort.pas HeapSort.p

Procedure ShellSort ();
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;

================================================================================

procedure ShellSort(var Arr : array of Real; N : Integer);
var
  C:   Boolean;
  Tmp: Real;
  E, G: Integer;
  I, J: Integer;
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;

================================================================================

procedure ShellSort(var item: DataArray; count:integer);
const
  t = 5;
var
  i, j, k, s, m: integer;
  h: array[1..t] of integer;
  x: DataItem;
begin
  h[1]:=9; h[2]:=5; h[3]:=3; h[4]:=2; h[5]:=1;
  for m := 1 to t do
    begin
  k:=h[m];
  s:=-k;
  for i := k+1 to count do
  begin
    x := item[i];
    j := i-k;
    if s=0 then
    begin
      s := -k;
      s := s+1;
      item[s] := x;
    end;
    while (x<item[j]) and (j<count) do
      begin
        item[j+k] := item[j];
        j := j-k;
      end;
      item[j+k] := x;
    end;
  end;
end; { конец сортировки Шелла }

================================================================================

program shell_sort;
const n=18;
   a:array[1..n] of integer 
     =(18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1);
var ii,m,x,s,p,t,k,r,i,j: integer;
begin
 t:= trunc(ln(n)/ln(2));
  repeat
   t:= t-1;
   k:= (1 shl t)-1;
   p:= n mod k; 
   s:= n div k;
   if p=0 then p:= k
     else s:= s+1;

     writeln(k,'-сортировка');
      for i:= 1 to k do {берем и длинные, и короткие подпоследовательности}
         begin
        if i= p+1 then s:= s-1; (для коротких - уменьшаем     длину}
      for j:= 1 to s-1 do   {метод ПрВст с шагом k}
        if a[i+(j-1)*k]>a[i+j*k]
         then begin x:= a[i+j*k];
          m:= i+(j-1)*k;
          while (m>0) and (a[m]>x) do
          begin a[m+k]:= a[m];
             m:= m-k;
            end;
            a[m+k]:= x;
         end;
       for ii:= 1 to n do write(a[ii],' ');
      writeln;
   end;
  until k=1;
end.