Добавить комментарий

Терпеливая сортировка получила своё название, потому что patience - одно из названий пасьянса "Солитёр".

Берём исходные данные и раскладываем в стопки, так, чтобы добавляемый в стопку элемент был не больше верхнего элемента стопки. Новый элемент кладётся в самую левую стопку из возможных. Если подходящей стопки не нашлось, справа создаётся новая стопка. Подходящую стопку ищём бинарным поиском.

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

Извлекаем верхний элемент левой стопки. Если в ней не осталось элементов, переставляем на её место самую правую стопку и просеиваем дерево вниз.

type
  TAI = array of integer;
...
procedure PatienceSort(var A: TAI);
var
  i: Integer;
  // TList<integer> - стопка. Список целых чисел.
  // Stacks - список стопок.
  Stacks: TList<TList<integer>>;
  l,r,m: integer;

  // Просеивание кучи
  procedure Heapify(Index: integer);
  var
      mi: integer;     // Индекс минимального подузла.
      li,ri: integer;  // Индексы левого и правого подузлов.
  begin
    li := Index*2 + 1;
    if li < Stacks.Count then // Если есть подузлы...
    begin
      ri := Index*2 + 2;
      if ri < Stacks.Count then // Если подузлов два,
      begin // найдём миниальный из них.
        if Stacks.Items[li].Items[Stacks.Items[li].Count-1] <=
           Stacks.Items[ri].Items[Stacks.Items[ri].Count-1]
        then mi := li
        else mi := ri;
      end
        else mi := li;
      // Теперь в mi - индекс минимального подузла.
      // Если он меньше текущего узла,
      if Stacks.Items[mi].Items[Stacks.Items[mi].Count-1] <
         Stacks.Items[Index].Items[Stacks.Items[Index].Count-1] then
      begin // обменяем местами узлы и продолжим просеивание.
        Stacks.Exchange(Index, mi);
        Heapify(mi);
      end;
    end;
  end;


begin
  Stacks := TList<TList<integer>>.Create;
  try
    // Для каждого элемента входящей последовательности
    for i := Low(A) to High(A) do
    begin
      // ищем стопку бинарным поиском.
      l := 0;
      r := Stacks.Count;
      while r > l do
      begin
        m := (l+r) div 2;
        if Stacks.Items[m].Items[stacks.Items[m].Count -1]>=A[i]
          then r := m
          else if l<m then l := m
                      else break;
      end;
      // Если не нашлось,
      if r >= Stacks.Count then
      begin // создаём новую стопку.
        Stacks.Add(TList<integer>.Create);
        Stacks.Items[Stacks.Count-1].Add(A[i]);
      end
        else stacks.Items[r].Add(A[i]);
    end;
    // Теперь элементы разложены по стопкам, при этом
    // стопки упорядочены по возрастанию последнего элемента.
    // Stacks.Items[i].Items[Stacks.Items[i].Count-1] <
    // Stacks.Items[i+1].Items[Stacks.Items[i+1].Count-1]
    // Т.е. с ними можно работать как с бинарной кучей.
    // Начинаем извлекать элементы.
    for i := Low(A) to High(A) do
    begin
      // Забираем верхний элемент левой кучи.
      A[i] := Stacks[0].Items[Stacks[0].Count-1];
      Stacks[0].Delete(Stacks[0].Count-1);
      // Если в ней не осталось элементов,
      if Stacks[0].Count=0 then
      begin // поместим на её место самую правую кучу.
        Stacks.Items[0].Free;
        Stacks.Items[0] := Stacks.Items[Stacks.Count-1];
        Stacks.Delete(Stacks.Count-1);
      end;
      // Просеиваем от корня.
      Heapify(0);
    end;
  finally
    Stacks.Free;
  end;
end;

Сложность: