Плавная сортировка

Дальнейшее развитие идей пирамидальной сортировки.

Будем укладывать данные в кучи, основанный на числах Леонардо.

K-я куча Леонардо - это двоичное дерево, в котором количество вершин равно L(k), при этом число в корне не меньше чисел в подузлах, и левым поддеревом является (k-1)-я куча Леонардо, а правое поддерево - (k-2)-я куча Леонардо.

Будем называть k - уровнем кучи.

Любое натуральное число представимо в виде суммы различных чисел Леонардо, поэтому любую последовательность чисел можно разложить в ряд куч Леонардо с убывающим уровнем. Например, так.

Возьмём массив сортируемых данных. Какую-то часть слева будем считать областью куч. Тогда добавление элемента будет заключаться в сдвиге указателя края кучи вправо и приведении области куч в соответствие правилам. Крайний правый элемент области куч всегда будем максимальным. Извлечение максимального элемента - это просто сдвиг указателя области куч влево. Конечно, после этого потребуется новое приведение кучи, чтобы максимальный элемент из оставшихся снова стал самым правым.

Подробное описание шагов алгоритма на словах можно почитать здесь.

На Delphi сортировка может быть реализована так:

type
  TAI = array of integer;
...
procedure SmoothSort(var A: TAI);
var
    HeapEnd: integer;      // Индекс последнего элемента области куч.
    Heaps:TList<integer>;  // Список куч. Тут будут хранится их уровни.

    // Функция возвращает число Леонардо с номером N
    function Leonardo(N: integer):integer;
    var
        pre, prepre : integer;
        i: Integer;
    begin
      result := 1;
      prepre := 1;
      for i := 2 to N do
      begin
        pre := prepre;
        prepre := result;
        result := pre + prepre +1;
      end;
    end;

    // Для узла с индексом Root и уровнем Level
    //  Возвращаем индекс левого подузла.
    function Left(Root, Level: integer): integer;
    begin
      result := Root - Leonardo(Level) + Leonardo(Level-1);
    end;

    // Для узла с индексом Root и уровнем Level
    //  Возвращаем индекс правого подузла.
    function Right(Root, Level: integer): integer;
    begin
      result := Root - 1;
    end;

    // Просеивание кучи вниз, начиная с узла с индексом Root
    //  и уровнем Level
    Procedure ShiftDown(Root:integer; Level:integer);
    var
        l,r: integer;
    begin
      // Если уровень меньше двух, дальше подузлов нет,
      //  можно заканчивать.
      if Level<2 then Exit;

      // Определим индексы левого и правого подузлов.
      l := Left(Root, Level);
      r := Right(Root, Level);
      // Если значение в корне меньше, обменяем их с максимальным
      //  из подузлов и продолжим просеивание того узла,
      //  с которым поменялись.
      if A[l] > A[r] then
      begin
        if A[Root] < A[l] then
        begin
          swap(A[Root], A[l]);
          ShiftDown(l, Level - 1);
        end;
      end
        else
      begin
        if A[Root]<A[r] then
        begin
          swap(A[Root], A[r]);
          ShiftDown(r, Level - 2);
        end;
      end;
    end;

    // Приведение в порядок области куч после добавления элемента.
    procedure Heapify;
    var
        CurrentHeap  : integer;  // Индекс текущей кучив списке.
        HeapPosition : integer;  // Индекс корня текущей кучи в массиве.
        PrevHeap : integer;      // Индекс корня предыдущей кучи.
    begin
      // Начинаем с самой правой кучи.
      CurrentHeap  := Heaps.Count-1;
      HeapPosition := HeapEnd;
      // Проверяемся, пока не дошли до начала списка куч.
      while (CurrentHeap>0) do
      begin
        // Определяем индекс корня предыдущей кучи.
        PrevHeap := HeapPosition-Leonardo(Heaps.Items[CurrentHeap]);
        // Если значение в корне предыдущей кучи больше,
        //  чем в текущей и больше, чем в обоих подузлах текущей,
        if (A[HeapPosition] < A[PrevHeap]) and
           ((Heaps.Items[CurrentHeap]<2) or
            ((A[PrevHeap] > A[Left(HeapPosition, Heaps.Items[CurrentHeap])]) and
             (A[PrevHeap] > A[Left(HeapPosition, Heaps.Items[CurrentHeap])]))
           ) then
        begin
          // обменяем зхначения в конях текущей и предыдущей кучи,
          swap(A[HeapPosition],A[PrevHeap]);
          // и предыдущая куча становится текущей.
          dec(CurrentHeap);
          HeapPosition := PrevHeap;
        end
          else break;
      end;
      // Если добавили не самое большое значение,
      //  оно сдвинулось влево по корням куч до кучи CurrentHeap и
      //  позиции HeapPosition в массиве. Эту кучу нужно просеять,
      //  возможно добавленное значение уйдёт вглубь.
      ShiftDown(HeapPosition, Heaps.Items[CurrentHeap]);
    end;

    // Добавление элемента.
    procedure AddElement;
    begin
      // Если уровень последней кучи на 1 меньше уровня предпоследней,
      if (Heaps.Count>1) and (Heaps[Heaps.Count-2]-Heaps[Heaps.Count-1] = 1) then
      begin // их надо объединить.
        Heaps.Items[Heaps.Count-2] := Heaps.Items[Heaps.Count-2] +1;
        Heaps.Delete(Heaps.Count-1);
      end
        else
      begin // Если нет, новый элемент начинает новую кучу.
        if (Heaps.Count>0) and (Heaps[Heaps.Count-1]=1)
          then Heaps.Add(0)
          else Heaps.Add(1);
      end;
      // Область куч наползает на добавляемый элемент,
      inc(HeapEnd);
      // После чего кучи нужно привести в порядок.
      Heapify;
    end;

    // Извлечение эолемента.
    procedure ExtractElement;
    var
        PreHeap : integer; // Индекс корня предыдущей кучи.
        lSubHeap: integer; // Индекс левого подузла.
    begin
      // Кучи отступают, оставляя самый правый элемент,
      //  потому что он максимальный.
      dec(HeapEnd);
      // Это был корень самой правой кучи.
      // Если у извлечённого элемента небыло подузлов,
      if Heaps[Heaps.Count-1]<2
        then Heaps.Delete(Heaps.Count-1) // просто удалим правую кучу.
        else begin // Если подузлы были,
               // каждый из них становится самостоятельной кучей.
               Heaps.Items[Heaps.Count-1] := Heaps.Items[Heaps.Count-1] -1;
               Heaps.Add(Heaps[Heaps.Count-1]-1);
               // Определяем положение левого подузла.
               lSubHeap := HeapEnd - Leonardo(Heaps.Items[Heaps.Count-1]);
               // Если у извлечённого элемента была куча левее.
               if Heaps.Count>2 then
               begin
                 // Найдём индекс корня предыдущей кучи.
                 PreHeap  := lSubHeap - Leonardo(Heaps.Items[Heaps.Count-2]);
                 // Если в левом подузле, значение меньше,
                 // чем в корне предыдущей кучи,
                 if (A[lSubHeap] < A[PreHeap]) then
                 begin // обменяем и просеем предыдущую кучу.
                   swap(A[lSubHeap], A[PreHeap]);
                   ShiftDown(PreHeap, Heaps.Items[Heaps.Count-3]);
                 end;
               end;
               // Если в правом подузле значение меньше, чем в левом
               //  (сразу такое было или приехало из предыдущей кучи),
               if (A[HeapEnd] < A[lSubHeap]) then
               begin // обменяем и просеем левый подузел.
                 swap(A[HeapEnd], A[lSubHeap]);
                 ShiftDown(lSubHeap, Heaps.Items[Heaps.Count-2]);
               end;
               if Heaps.Count>2 then
               begin
                 // Если после обменов и просеиваний, в корень предыдущей
                 // кучи всплыло значение, которое больше значения
                 // левого подузла,
                 if (A[lSubHeap] < A[PreHeap]) then
                 begin // Ещё раз обмениваем и просеиваем.
                   swap(A[lSubHeap], A[PreHeap]);
                   ShiftDown(PreHeap, Heaps.Items[Heaps.Count-3]);
                 end;
               end;
             end;
    end;

begin
  // Создаём список куч.
  Heaps := TList<integer>.Create;
  // Ни один элемент массива ещё не входит в кучи.
  HeapEnd := -1;
  // Добавляем элементы по одному.
  while HeapEnd<High(A) do
    AddElement;
  // Теперь все элементы уложены в последователшьность куч,
  //  максимальный элемент лежит самым правым.
  // Начинаем извлекать по одному.
  while HeapEnd>0 do
    ExtractElement;
  // После каждого извлечения область куч уменьшается и максимальный
  //  элемент из оставшихся оказывается самым правым в этой области.

  // Когда область куч схлопнется, весь массив окажется отсортированным по возрастанию.
  Heaps.Free;
end;

Сохраняя хорошее быстродействие на случайных данных этот алгоритм получает существенное преимущество на частично отсортированных последовательностях.

Сложность:

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