TimSort

Это гибридный алгоритм, сочетающий подходы других сортировок, и привносящий модификации, которые позволяют существенно ускорить работу на частично отсортированных данных.

  1. Исходный массив нужно разбить на подмассивы ("раны"), стараясь выделить как можно большие участки монотонно возрастающих или убывающих значений (см. GetRun). При этом размер одного рана не должен быть некоторого минимального значения MinRun.
    Это число не должно быть очень большим, потому что первоначальные раны мы хотим сортировать вставками, а этот алгоритм неэффективен на больших наборах данных.
    Это число не должно быть очень маленьким, чтобы нам не пришлось проводить большое число слияний крошечных ранов.
    И, наконец, было бы хорошо, если бы отношение размера исходных данных, к минимальному размеру рана было степенью двойки или близким к нему, тогда мы сможем проводить объединение ранов примерно равных размеров, достигая максимальной эффективности сортировки слиянием. Петерс утверждает, что MinRun должен быть в диапазоне от 8 до 256, а наилучшие показатели достигаются, когда MinRun находится в диапазоне 32..64.
  2. Сортируем каждый первичный ран сортировкой вставками.
  3. Объединяем полученные раны сортировкой слиянием, с некоторыми модификациями:
    1. Выбор ранов для объединения. Все раны поместим в стек. Объединяем всегда только второй ран с первым или третьим(с меньшим по размеру). Прекращаем объединение, когда верхний ран больше суммы второго и третьего, и второй ран больше третьего. Выполнение этого правила приводит к тому, что мы объединяем раны примерного одинакового размера.
    2. Объединение ранов производим сортировкой слиянием. Полученый ран тоже будет отсортированым. 
    3. Если в процессе объединения в результат переносятся несколько элементов подряд(обычно 7) из одного и того же источника, алгоритм переходит в "галоп": вместо того, чтобы последовательно проверять и переносить по одному элементу, окончание блока данных, подходящих для переноса в результат определяется бинарным поиском, потом данные копируются единым блоком.

Код:

procedure TimSort(var A: TAI);
type
     // Данные об одном ране.
     TRun = record
              Start,            // Индекс первого элемента.
              Length : integer; // Длина в элементах.
            end;
var
    MinRun     : integer;      // Минимальная длина ранов.
    CurrentRun : TRun;         // Текущий ран.
    Current    : integer;      // Текущая позиция обработки.
    RunList    : TList<TRun>;  // Стек обнаруженных ранов.


    // Определяем длину минимального рана.
    function GetMinRun(N: integer):integer;
    var
        r : integer;
    begin
      r := 0;
      while N>=64 do
      begin
        r := r or (N and 1);
        N := N shr 1;
      end;
      result := N + r;
    end;

    // Выделяем ран, начиная с позици Start
    function GetRun(Start: integer): TRun;
    var
        i : integer;
        asc : boolean;
    begin
      result.Start := Start;
      // Если остаток маленький,
      if (Start+MinRun) > Length(A) then
      begin // то он и есть весь нашщ ран.
        result.Length := High(A) - Start + 1;
      end
        else
      begin
        i := Start;
        // Определяем направление рана.
        asc := A[i]<=A[i+1];
        // Пока направление сохраняется, движемся по массиву.
        while i<Length(A)-1 do
        begin
          if (A[i]=A[i+1]) or
             (Asc xor (A[i]>A[i+1]))
            then inc(i)
            else Break;
        end;
        // Выделили монотонную последовательность,
        //   но она не должна быть слишком маленькой.
        if i-Start<MinRun then result.Length := MinRun
                          else result.Length := i-Start +1;
      end;
    end;

    // Сортировка вставками диапазона A[Left..Right]
    procedure InsertionSort(Left, Right: integer);
    var
        i, j: integer;
    begin
      for i := Left+1 to Right do
      begin
        j := i;
        while (j > Left) and (A[j] < A[j-1]) do
        begin
          swap(A[j], A[j-1]);
          dec(j);
        end;
      end;
    end;

    // Галоп.
    // Перенос из Source в Target значений, которые <= Value
    procedure Gallop(Source, Target: TAI; SourceIndex, TargetIndex, Value: integer);
    var
        left, right, mid: integer;
    begin
      // Двоичным поиском находим границу переноса
      // (Source должен быть упорядочен по возрастанию)
      left  := SourceIndex -1;
      right := High(Source)+1;
      while right-left>1 do
      begin
        mid   := (left + right) div 2;
        if Source[mid]<=Value then left := mid
                              else right := mid;
      end;
      // Переносим элементы с индексами от SourceIndex по left включительно
      Move(Source[SourceIndex], Target[TargetIndex], (left-SourceIndex +1) * SizeOf(Source[0]));
    end;

    // Слияние двух ранов.
    procedure Merge(Left, Right:integer);
    var
        W     : TAI;
        i,j, r: integer;
        cr    : TRun;
        cnt   : integer;
    begin
      // Копируем левый ран во временный массив
      SetLength(W, RunList.Items[Left].Length);
      Move(A[RunList.Items[Left].Start], W[0], RunList.Items[Left].Length * SizeOf(A[0]));

      i := 0; // Текущий элемент во временном массиве
      j := 0; // Текущий элемент в правом массиве
      r := RunList.Items[Left].Start; // Текущий элемент результата

      repeat
        // Переносим в результат из временного массива.
        cnt := 0;
        while (i<RunList.Items[Left].Length) and
              ((j>=RunList.Items[Right].Length) or (W[i]<=A[j+RunList.Items[Right].Start])) do
        begin
          A[r] := W[i];
          inc(r);
          inc(i);
          inc(cnt);
          // Если перенеслось много элементов подряд,
          if cnt>=7 then
          begin // переходим в галоп.
            Gallop(W, A, i, r, A[j+RunList.Items[Right].Start]);
            Break;
          end;
        end;
        // Переносим в результат из правого рана.
        cnt :=0;
        while (j<RunList.Items[Right].Length) and
              ((i>=RunList.Items[Left].Length) or 
               (W[i]>=A[j+RunList.Items[Right].Start])) do
        begin
          A[r] := A[j+RunList.Items[Right].Start];
          inc(r);
          inc(j);
          // Если перенеслось много элементов подряд,
          if cnt>=7 then
          begin // переходим в галоп.
            Gallop(A, A, j, r, W[i]);
            Break;
          end;
        end;
      until (i>=RunList.Items[Left].Length) and
            (j>=RunList.Items[Right].Length);
      // Последовательности слились,
      //  объединяем записи о ранах.
      cr.Start  := RunList.Items[Left].Start;
      cr.Length := RunList.Items[Left].Length +
                   RunList.Items[Right].Length;
      RunList.Items[Left] := cr;
      RunList.Delete(Right);
    end;

    // Сеанс слияния.
    procedure Interflow;
    begin
      // Работаем с RunList, как со стеком ранов.
      // Обрабатываем три верхних рана(пусть X,Y,Z - их размеры), пока не добъёмся соблюдения:
      //  (X > Y + Z) and (Y > Z)
      //  Пока условие не соблюдается, массив Y, объединяем с меньшим из X и Z.
      while ((RunList.Count>1) and (RunList.Items[1].Length<=RunList.Items[0].Length)) or
            ((RunList.Count>2) and 
             (RunList.Items[2].Length <= RunList.Items[0].Length+RunList.Items[2].Length)) do
      begin
        if RunList.Items[1].Length<=RunList.Items[0].Length
          then Merge(1,0)
          else if RunList.Items[0].Length < RunList.Items[2].Length
                 then Merge(1,0)
                 else Merge(2,1);
      end;
    end;

begin
  RunList := TList<TRun>.Create;
  // Определяем минимальный размер рана.
  MinRun := GetMinRun(Length(A));

  Current := 0;
  repeat
    // Выделяем новый ран.
    CurrentRun := GetRun(Current);
    // Сортируем его вставками.
    InsertionSort(CurrentRun.Start, CurrentRun.Start + CurrentRun.Length - 1);
    // Сдвигаем указатель обработанного массива.
    inc(Current, CurrentRun.Length);
    // Добавляем запись о ране в стек.
    RunList.Insert(0, CurrentRun);
    // Проводим сеанс слияния.
    Interflow;
  until Current>=Length(A);
  // Объединяем оставшиеся раны.
  while RunList.Count>1 do
    Merge(1,0);
  // Сортировка закончена.
  RunList.Free;
end;

Сложность:

Максимальная O(N log(N))
Минимальная O(N)
Средняя O(N log(N))

 

Метки: