О QuickSort не говори

Август 9, 2010 — Шарахов А.П.

Со времен пузырька человечество безотрывно интересуется скоростью сортировки. В этих заметках его бесценный опыт использован для уменьшения времени работы QuickSort в Delphi примерно в 1.5 раза. В качестве способов повышения скорости сортировки также будет рассмотрено использование алгоритма двухопорной сортировки и языка ассемблера.

Предварительные замечания

Быстрая сортировка в Delphi – это модификация знаменитой процедуры, автором которой является Charles Hoare. Его идея заключается в произвольном выборе из массива опорного элемента и рекурсивном разбиении массива на две части, состоящие из элементов, меньших и больших опорного. Процедура QuickSort в Delphi содержит ряд более поздних усовершенствований: выбор центрального элемента в качестве опорного (Roger Scowen), встречное движение индексов (Robert Sedgewick) и перестановка равных элементов (Richard Singleton).

procedure QuickSort(List: PPointerList; L, R: Integer; Compare: TListSortCompare);
var
  I, J: Integer;
  P, T: Pointer;
begin;
  repeat;
    I:=L;
    J:=R;
    P:=List[(L + R) shr 1];
    repeat;
      while Compare(List[I], P)<0 do Inc(I);         //*
      while Compare(List[J], P)>0 do Dec(J);         //*
      if I<=J then begin;                            //**
        T := List[I]; List[I]:=List[J]; List[J]:=T;
        Inc(I);
        Dec(J);
        end;
      until I>J;
    if L<J then QuickSort(List, L, J, Compare);      //***
    L:=I;
    until I>=R;
  end;

С первого взгляда видно, что реализация сортировки может быть слегка подправлена.

Сравнение (**) можно заменить на противоположное с использованием оператора break. Это даст небольшое ускорение, хотя и сильно смахивает на ловлю блох.

Заметим, что после разбиения массива рекурсивный вызов (***) всегда производится для левой части массива, что может привести к неконтролируемому росту стека. Стандартное решение проблемы – рекурсия для меньшей части.

Есть еще одна вещь, которая иногда меня беспокоит, – нестабильность времени быстрой сортировки. Лекарством от паранойи в данном случае служит сортировка кучей, пусть в 2 раза медленней, зато время почти не зависит от входных данных. Но не будем о грустном, лучше скажем пару слов

О бедном сравнении

Немного раздражает, что в QuickSort после вызова функций сравнения (*) результат сравнивается с нулем на больше-меньше. Понятно, что если изменить порядок параметров во втором операторе, то в обоих случаях будет необходимо тестировать знак результата только на отрицательность. Это, в свою очередь, позволит упростить функцию сравнения. Недавно John Herbster пошел чуть дальше и предложил использовать в QuickSort функции сравнения, возвращающие результат типа boolean.

Другое его предложение состоит в том, чтобы не вызывать функцию сравнения с одинаковыми аргументами, когда ее результат и так ясен. Т.е. вместо

while Compare(List^[I], P)<0 do Inc(I);

писать
while (List^[I]<>P) and (Compare(List^[I], P)<0) do Inc(I);

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

И наконец, если функция сравнения, используемая в QuickSort, состоит из одного-двух операторов, то вместо переопределения функции сравнения иногда имеет смысл задуматься о переопределении самой процедуры сортировки со встроенными в нее операторами сравнения.

Гибридизацией по воробьям

Вероятно, Richard Singleton был первым гибридизатором, предложившим скрестить QuickSort и InsertionSort (сортировку вставками). Это самое серьезное улучшение, оно почти в 1.5 раза увеличивает производительность сортировки на массивах до 1000 элементов, т.к. теперь QuickSort дробит массив не до конца, а на достаточно мелкие части, с которыми затем разбирается InsertionSort. Хотя для несортированных массивов этот прием обычно приводит к существенному увеличению количества перестановок элементов и вызовов функции сравнения, он позволяет резко уменьшить число рекурсивных вызовов. Следовательно, эффективность сортировки в значительной мере зависит от простоты ее основного цикла.

Интересно, каковы эти “достаточно мелкие части” и как их размер зависит от компьютера. Donald Knuth рекомендовал переходить на InsertionSort при размере в 9 элементов, на ЕС ЭВМ оптимальным размером было 14, на 486 – примерно 20, сейчас на E6850 – 35 элементов для случайных данных и примерно 44 элемента, если часто приходится работать с данными, которые уже отсортированы.

Примечательно, что и Richard Singleton, и Donald Knuth в своих алгоритмах вызывали сортировку вставками для каждого мелкого подмассива, полученного в результате разбиения. Только позднее Robert Sedgewick предложил эту работу выполнять за один проход. Вот как выглядит

Хорошо забытое старое

const
  InsCount = 35; //33..49;
  InsLast = InsCount-1;
 
procedure InsertionSortSha(List: PPointerList; Last: integer; Compare: TListSortCompare);
var
  I, J: integer;
  T: pointer;
begin;
  I:=0;
  J:=Last; if J>InsLast then J:=InsLast;
  repeat;
    if (Compare(List[J], List[I])<0) then I:=J;
    dec(J);
    until J<=0;
  if I>0 then begin;
    T:=List[0]; List[0]:=List[I]; List[I]:=T; 
    end;
 
  J:=1;
  while true do begin;
    if J>=Last then break;
    inc(J);
    if Compare(List[J],List[J-1])<0 then begin;
      T:=List[J];
      I:=J;
      repeat;
        List[I]:=List[I-1];    
        dec(I);
        until not (Compare(T,List[I-1])<0);
      List[I]:=T;    
      end;
    end;
  end;
 
procedure QuickSortSha(List: PPointerList; L, R: Integer; Compare: TListSortCompare);
var
  I, J: Integer;
  P, T: Pointer;
begin;
  I:=L;
  J:=R;
  while true do begin;
    P:=List[(I+J) shr 1];
    repeat;
      repeat;
        Inc(I);                               
        until not (Compare(List[I-1], P)<0);
      Dec(I);                                  //****
      repeat;
        Dec(J);                                
        until not (Compare(P, List[J+1])<0);
      Inc(J);                                  //****
      if I>J then break;                       //*****
      T:=List[I]; List[I]:=List[J]; List[J]:=T;
      Inc(I);
      Dec(J);
      until I>J;                               //*****
 
    if (J-L)<(R-I) then begin;
      if (R-I)<=InsLast then break;
      if (J-L)>InsLast then QuickSortSha(List,L,J,Compare);
      L:=I;
      J:=R;
      end
    else begin;
      if (J-L)<=InsLast then break;
      if (R-I)>InsLast then QuickSortSha(List,I,R,Compare);
      I:=L;
      R:=J;
      end;
    end;
  end;
 
//~1.45 times faster than Delphi QuickSort on E6850
procedure HybridSortSha(List: PPointerList; Count: Integer; Compare: TListSortCompare);
begin;
  if (List<>nil) and (Count>1) then begin;
    Count:=Count-1;
    if Count>InsLast then QuickSortSha(List, 0, Count, Compare);
    InsertionSortSha(List, Count, Compare);
    end;
  end;

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

В процедуре QuickSortSha мне не нравится то, что ради скорости выполнения пришлось согласиться на пляски с увеличением-уменьшением индексов (****), что явно не добавляет ей красоты. Также некоторое неудовольствие вызывает участок (*****), содержащий два одинаковых условия. Подсознательно чувствуется, что одно сравнение здесь лишнее. Все эти чувства подталкивают нас

Выбрать лучшее почти даром

Richard Singleton известен также своим предложением в качестве опорного элемента выбирать средний из трех элементов: первый, последний или центральный. Точнее, он предложил сначала сортировать эти три элемента, а затем ставить их на те же места в отсортированном порядке. Следуя этому правилу, мы выберем лучшее значение опорного элемента, что уменьшит общее количество сравнений при сортировке массива. Кроме того, мы упорядочим три элемента за 2,66 сравнений. Не пользуясь этим правилом, мы все равно потратим 2 сравнения на частичное упорядочивание этих трех элементов.

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

  while true do begin;
    repeat; Inc(I); until not (Compare(List[I], P)<0);
    repeat; Dec(J); until not (Compare(P, List[J])<0);
    if I>=J then break;
    T:=List[I]; List[I]:=List[J]; List[J]:=T;
    end;
  if I=J then begin;      //******
     Inc(I); Dec(J);    
    end;

Вот только хвостик (******) немного смущает. Не хочется, чтобы процедура была напичкана необязательными проверками. И в самом деле, этот блок кода необязательный, без него все будет работать. Давайте разберемся, откуда он взялся. Если сканирование вправо было завершено на элементе, большем опорного, то сканирование влево пропустит этот элемент, и разбиение массива закончится, когда J=I-1. Если же сканирование вправо было завершено на элементе, равном опорному, то сканирование влево также остановится на этом элементе, и разбиение массива закончится, когда J=I, а блок (******) скорректирует границы частей массива. Исключение этого блока приведет всего лишь к увеличению размера полученных частей на 1. Тем не менее, существует небольшой трюк, который позволит избежать этого. Заменим проблемный блок на

    Dec(I); Inc(J);

и будем считать, что элементы [L..I] принадлежат левой части массива, а элементы [J..R] – правой.

После всех изменений процедура приобретает вид:

procedure QuickSortSha_AII(List: PPointerList; L, R: integer; Compare: TListSortCompare);
var
  I, J, M: integer;
  P, T: pointer;
begin;
  while true do begin;
    J:=R;
    I:=L;
    if J-I<=InsLast then break;
    M:=(I+J) shr 1;
    P:=List[M];
 
    if Compare(List[J], List[I])<0 then begin;
      T:=List[I]; List[I]:=List[J]; List[J]:=T;
      end;
    if Compare(P, List[I])<0 then begin;
      P:=List[I]; List[I]:=List[M]; List[M]:=P;
      end
    else if Compare(List[J], P)<0 then begin;
      P:=List[J]; List[J]:=List[M]; List[M]:=P;
      end;
 
    repeat; Inc(I); until not (Compare(List[I], P)<0);
    repeat; Dec(J); until not (Compare(P, List[J])<0);
    if I<J then repeat;
      T:=List[I]; List[I]:=List[J]; List[J]:=T;
      repeat; Inc(I); until not (Compare(List[I], P)<0);
      repeat; Dec(J); until not (Compare(P, List[J])<0);
      until I>=J;
    dec(I); inc(J);
 
    if I-L<R-J then begin;
      if I-InsLast>L then QuickSortSha_AII(List,L,I,Compare);
      L:=J;
      end
    else begin;
      if J+InsLast<R then QuickSortSha_AII(List,J,R,Compare);
      R:=I;
      end;
    end;
  end;
 
//~1.55 times faster than Delphi QuickSort on E6850
procedure HybridSortSha_AII(List: PPointerList; Count: integer; Compare: TListSortCompare);
begin;
  if (List<>nil) and (Count>1) then begin;
    Count:=Count-1;
    if Count>InsLast then QuickSortSha_AII(List, 0, Count, Compare);
    InsertionSortSha(List, Count, Compare);
    end;
  end;

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

Так вот он какой, компилятор Delphi

Быстрая сортировка обладает какой-то мистической силой, заставляя снова возвращаться к ней. И каждый раз очередное “улучшение” оказывается или почти бесполезным, или приводит к замедлению работы. Для IA-32 и компилятора Delphi алгоритм на удивление хорошо сбалансирован.

Кажется, можно сократить количество параметров, передаваемых в QuickSort до трех: адрес массива, количество элементов, адрес функции сравнения. Несмотря на то, что при этом все параметры QuickSort передаются в регистрах, компилятор Delphi строит менее эффективный код процедуры, что приводит к замедлению работы.

Можно попробовать отказаться от рекурсии и эмулировать работу со стеком при помощи массива. Но на PC такой фокус не дает выигрыша во времени, если только не использовать ассемблер, т.к. отсутствие рекурсивных вызовов QuickSort компенсируется наличием дополнительных переменных и, как следствие, менее эффективным кодом.

И все-таки интересно, насколько можно увеличить скорость работы гибридной сортировки, если отжать всю воду, добавленную компилятором. Чтобы ответить на этот вопрос, нам придется вооружиться BASM и начать войну за последний такт. Забегая вперед, скажу, что QuickSort на ассемблере в качестве параметров принимает три адреса: первого элемента, последнего элемента и функции сравнения. Она не содержит рекурсивных вызовов, а информация о сделанных разбиениях передается через стек. В итоге полностью ассемблерная реализация гибридной сортировки дает дополнительное ускорение примерно на 6%. Смешно.

Интересно, что при написании аналогичной версии QuickSort на чистом Pascal, чтобы не потерять скорость сортировки, пришлось для адресов использовать переменные типа cardinal, а не ppointer. Почему-то компилятор Delphi испытывает непреодолимую потребность хранить адресные типы в оперативной памяти, а не в регистрах. К этой особенности компилятора вернемся чуть позже, а пока будем изо всех сил стараться не потерять нить изложения.

Дорогой непрямой

Несмотря на полувековую историю исследования и совершенствования алгоритма, интерес к быстрой сортировке не ослабевает. Недавно он был снова подогрет алгоритмом DualPivotQuickSort, который предложил Владимир Ярославский (Vladimir Yaroslavskiy). Основное отличие его алгоритма от QuickSort состоит в том, что, благодаря выбору двух опорных элементов, сортируемый массив на каждом этапе делится на 3 части. Эту идею впервые опубликовал Robert Sedgewick в тезисах своей диссертации (алгоритм 5.1).

К сожалению, полноценная проверка двухопорных алгоритмов возможна только на ассемблере. Дело в том, работа с двумя опорными элементами сложнее, и нам потребуется 3 или 4 переменных индекса. А в этом случае нет уверенности, что компилятор Delphi разместит их в регистрах, и самым быстрым окажется не тот, кто быстрее бегает, а тот, кто быстрее бегает в мешке.

Но прежде, чем взяться за BASM, давайте убьем несколько зайцев:
• попробуем разобраться, что не так с компилятором;
• покажем, что несмотря ни на что на Delphi иногда можно писать код, почти равный по эффективности ассемблерному;
• перепишем QuickSort на Pascal, стараясь максимально приблизиться к будущей ассемблерной процедуре по передаваемым параметрам и результирующему коду.

В то время как ассемблерный код, который генерирует компилятор Delphi для операций с целыми числами, достаточно хорошо предсказуем, его шаблоны для работы с указателями остаются загадкой. Приходится проверять, что там в итоге получилось. С этой проблемой мы столкнулись при попытке уменьшить количество параметров, передаваемых QuickSort. Напомню, что идея состояла в том, чтобы не передавать левую границу массива, а считать, что она всегда равна нулю. На деле оказалось, что такая процедура работает заметно медленнее, хотя ее код почти полностью идентичен предыдущему:

procedure QuickSortSha_A0I(List: PPointerList; R: integer; Compare: TListSortCompare);
var
  I, J: integer;
  P, T: pointer;
begin;
  while true do begin;
    J:=R;
    if J<=InsLast then break;
    I:=J shr 1;
    P:=List[I];
 
    if Compare(List[J], List[0])<0 then begin;
      T:=List[0]; List[0]:=List[J]; List[J]:=T;
      end;
    if Compare(P, List[0])<0 then begin;
      P:=List[0]; List[0]:=List[I]; List[I]:=P;
      end
    else if Compare(List[J], P)<0 then begin;
      P:=List[J]; List[J]:=List[I]; List[I]:=P;
      end;
 
    I:=0;
    repeat; Inc(I); until not (Compare(List[I], P)<0);
    repeat; Dec(J); until not (Compare(P, List[J])<0);
    if I<J then repeat;
      T:=List[I]; List[I]:=List[J]; List[J]:=T;
      repeat; Inc(I); until not (Compare(List[I], P)<0);
      repeat; Dec(J); until not (Compare(P, List[J])<0);
      until I>=J;
    dec(I); inc(J);
 
    if I+J<=R then begin;
      if I>InsLast then QuickSortSha_A0I(List,I,Compare);
      R:=R-J;
      //Next line replaced for speed reason (to make Delphi compiler place List in the register)
      //List:=@List[J];
      integer(List):=integer(@List[J]);
      end
    else begin;
      //Next line replaced for speed reason (to make Delphi compiler place List in the register)
      //if J+InsLast<R then QuickSortSha_A0I(@List[J],R-J,Compare);
      if J+InsLast<R then QuickSortSha_A0I(pointer(integer(@List[J])),R-J,Compare);
      R:=I;
      end;
    end;
  end;
 
//~1.55 times faster than Delphi QuickSort on E6850
procedure HybridSortSha_A0I(List: PPointerList; Count: integer; Compare: TListSortCompare);
begin;
  if (List<>nil) and (Count>1) then begin;
    Count:=Count-1;
    if Count>InsLast then QuickSortSha_A0I(List, Count, Compare);
    InsertionSortSha(List, Count, Compare);
    end;
  end;

Причина замедления оказалась в том, что пара операторов, а именно:

    List:=@List[J];
 
    if J+InsLast<R then QuickSortSha_A0I(@List[J],R-J,Compare);

заставляла компилятор Delphi размещать переменную List типа PPointerList на стеке, хотя в наличии имелись неиспользованные регистры. Решение состоит в том, чтобы привести “плохие типы” к типу integer, с которым компилятор работает без вывихов:

    integer(List):=integer(@List[J]);
 
    if J+InsLast<R then QuickSortSha_A0I(pointer(integer(@List[J])),R-J,Compare);

После такой замены времена работы обоих вариантов сортировки становятся равными.

Успех окрыляет

Будущая ассемблерная процедура в качестве параметров должна принимать три адреса: первого элемента массива, последнего элемента массива и функции сравнения. Как только что выяснилось, в ее аналоге на Delphi не должно быть проблем со скоростью, если для работы с адресами использовать целочисленные типы. Поэтому и для параметров, и для всех локальных переменных выберем тип cardinal.

Воодушевившись легкой победой, можно угодить в одну ловушку. Было бы ошибкой вычислять адрес среднего элемента по формуле

T:=(I+J) shr 1;

аналогично тому, как это делалось ранее. Попробуйте, например, по этой формуле вычислить адрес среднего элемента для двух соседних элементов массива. Чтобы вычисленный адрес указывал точно на начало элемента, надо написать нечто подобное:

T:=(I+J) shr 1 and $FFFFFFFC;

Но и это еще не все. При сложении адресов может возникнуть переполнение, и вычисленный адрес окажется за пределами массива. Например, если массив содержит 3 элемента, расположенных по адресам $7FFFFFFC, $80000000, $80000004, то в результате вычисления получится, что адрес среднего элемента равен нулю. К счастью, на входе процедуры всегда выполняется соотношение J>=I, и поэтому можно использовать формулу:

T:=(J-I) shr 1 and $FFFFFFFC + I;

Несложная замена типа переменных приводит процедуру сортировки к виду:

const
  SOP = SizeOf(pointer);
  MSOP = cardinal(-SOP);
 
procedure QuickSortSha_0AA(L, R: cardinal; Compare: TListSortCompare);
var
  I, J, P, T: cardinal;
begin;
  while true do begin;
    I:=L;
    J:=R;
    if J-I<=InsLast * SOP then break;
    T:=(J-I) shr 1 and MSOP + I;
 
    if Compare(ppointer(J)^, ppointer(I)^)<0 then begin;
      P:=pcardinal(I)^; pcardinal(I)^:=pcardinal(J)^; pcardinal(J)^:=P;
      end;
    P:=pcardinal(T)^;
    if Compare(pointer(P), ppointer(I)^)<0 then begin;
      P:=pcardinal(I)^; pcardinal(I)^:=pcardinal(T)^; pcardinal(T)^:=P;
      end
    else if Compare(ppointer(J)^, pointer(P))<0 then begin;
      P:=pcardinal(J)^; pcardinal(J)^:=pcardinal(T)^; pcardinal(T)^:=P;
      end;
 
    repeat; Inc(I,SOP); until not (Compare(ppointer(I)^, pointer(P))<0);
    repeat; Dec(J,SOP); until not (Compare(pointer(P), ppointer(J)^)<0);
    if I<J then repeat;
      T:=pcardinal(I)^; pcardinal(I)^:=pcardinal(J)^; pcardinal(J)^:=T;
      repeat; Inc(I,SOP); until not (Compare(ppointer(I)^, pointer(P))<0);
      repeat; Dec(J,SOP); until not (Compare(pointer(P), ppointer(J)^)<0);
      until I>=J;
    Dec(I,SOP); Inc(J,SOP);
 
    if I-L<=R-J then begin;
      if L + InsLast * SOP < I then QuickSortSha_0AA(L, I, Compare);
      L:=J;
      end
    else begin;
      if J + InsLast * SOP < R then QuickSortSha_0AA(J, R, Compare);
      R:=I;
      end;
    end;
  end;
 
//~1.57 times faster than Delphi QuickSort on E6850
procedure HybridSortSha_0AA(List: PPointerList; Count: integer; Compare: TListSortCompare);
var
  I, J, L, R: cardinal;
begin;
  if (List<>nil) and (Count>1) then begin;
 
    L:=cardinal(@List[0]);
    R:=cardinal(@List[Count-1]);
    J:=R;
    if Count-1>InsLast then begin;
      J:=cardinal(@List[InsLast]);
      QuickSortSha_0AA(L, R, Compare);
      end;
 
    I:=L;
    repeat;
      if Compare(ppointer(J)^, ppointer(I)^)<0 then I:=J;
      dec(J,SOP);
      until J<=L;
 
    if I>L then begin;
      J:=pcardinal(I)^; pcardinal(I)^:=pcardinal(L)^; pcardinal(L)^:=J;
      end;
 
    J:=L+SOP;
    while true do begin;
      repeat;
        if J>=R then exit;
        inc(J,SOP);
        until Compare(ppointer(J)^,ppointer(J+MSOP)^)<0;
      I:=J-SOP;
      L:=pcardinal(J)^;
      repeat;
        pcardinal(I+SOP)^:=pcardinal(I)^;
        dec(I,SOP);
        until not (Compare(pointer(L),ppointer(I)^)<0);
      pcardinal(I+SOP)^:=L;
      end;
 
    end;
  end;

Лень – двигатель прогресса

Зачем нужна ужасающего вида последняя процедура, если она выдает тот же самый результат, что и предыдущие, за то же самое время?

Во-первых, чтобы ее дизассемблировать и с минимальными затратами времени написать ассемблерную:

procedure QuickSortSha_0AA_ASM(L, R: pointer; Compare: TListSortCompare);
asm
  push ebx
  push esi
  push edi
  push ebp
  push -1              // end stack mark
  push 0               // end stack mark
  mov ebp, ecx
 
  //   L,    R,    I,  J,  P, Compare
  // [esp][esp+4] esi edi ebx ebp
 
@DoParts:
  mov ecx, [esp+4]
  sub ecx, [esp]       // next part size
  mov ebx, edx
  sub ebx, eax         // current part size
  cmp ebx, ecx
  mov esi, eax         // I:=L;
  mov edi, edx         // J:=R;
  jbe @Small           // need smallest part
 
  pop esi              // exchange parts
  pop edi
  push edx
  push eax
  mov ebx, ecx         // new part size
 
@Small:
  cmp ebx, InsLast * SOP // if J-I<=InsLast * SOP then break;
  ja @Split
 
  pop eax              // new current part
  pop edx
  test eax, eax        // is end mark?
  jnz @DoParts
 
  pop ebp
  pop edi
  pop esi
  pop ebx
  ret
 
@Split:
  shr ebx, 1
  and ebx, MSOP
  add ebx, esi         // T:=(J-I) shr 1 and MSOP + I;
  push edi             // save current part bounds
  push esi
 
  mov eax, [edi]
  mov edx, [esi]
  call ebp
  test eax, eax
  jge @OkLR            // if Compare(ppointer(J)^, ppointer(I)^)<0 then begin;
 
  mov eax, [esi]       // P:=pcardinal(I)^; pcardinal(I)^:=pcardinal(J)^; pcardinal(J)^:=P;
  mov edx, [edi]
  mov [esi], edx
  mov [edi], eax
 
@OkLR:
  mov eax, [ebx]
  mov edx, [esi]
  call ebp
  test eax, eax
  jge @OkLM            // if Compare(ppointer(T), ppointer(I)^)<0 then begin;
 
  mov eax, [ebx]       // P:=pcardinal(I)^; pcardinal(I)^:=pcardinal(T)^; pcardinal(T)^:=P;
  mov edx, [esi]
  mov [ebx], edx
  mov [esi], eax
  jmp @OkMR
 
@OkLM:
  mov eax, [edi]
  mov edx, [ebx]
  call ebp
  test eax, eax
  jge @OkMR            // else if Compare(ppointer(J)^, pointer(P))<0 then begin;
 
  mov eax, [edi]       // P:=pcardinal(J)^; pcardinal(J)^:=pcardinal(T)^; pcardinal(T)^:=P;
  mov edx, [ebx]
  mov [edi], edx
  mov [ebx], eax
 
@OkMR:
  mov ebx, [ebx]       // P:=pcardinal(T)^;
 
@FindLeft1:            // repeat; Inc(I,SOP); until not (Compare(ppointer(I)^, pointer(P))<0);
  add esi, SOP
  mov eax, [esi]
  mov edx, ebx
  call ebp
  test eax, eax
  jl @FindLeft1
 
@FindRight1:           // repeat; Dec(J,SOP); until not (Compare(pointer(P), ppointer(J)^)<0);
  sub edi, SOP
  mov edx, [edi]
  mov eax, ebx
  call ebp
  test eax, eax
  jl @FindRight1
 
  cmp esi, edi
  jae @ExchangesDone   // if I<J then repeat;
 
@Exchange:             // T:=pcardinal(I)^; pcardinal(I)^:=pcardinal(J)^; pcardinal(J)^:=T;
  mov eax, [esi]
  mov edx, [edi]
  mov [esi], edx
  mov [edi], eax
 
@FindLeft2:            // repeat; Inc(I,SOP); until not (Compare(ppointer(I)^, pointer(P))<0);
  add esi, SOP
  mov eax, [esi]
  mov edx, ebx
  call ebp
  test eax, eax
  jl @FindLeft2
 
@FindRight2:           // repeat; Dec(J,SOP); until not (Compare(pointer(P), ppointer(J)^)<0);
  sub edi, SOP
  mov edx, [edi]
  mov eax, ebx
  call ebp
  test eax, eax
  jl @FindRight2
 
  cmp esi, edi
  jb @Exchange         // until I>=J;
 
@ExchangesDone:
  sub esi, SOP         // Dec(I,SOP); Inc(J,SOP);
  add edi, SOP
  mov eax, [esp]
  mov [esp], edi       // QuickSort(J, R, Compare);
  mov edx, esi         // QuickSort(L, I, Compare);
  jmp @DoParts
  end;
 
//~1.59 times faster than Delphi QuickSort on E6850
procedure HybridSortSha_0AA_ASM(List: PPointerList; Count: integer; Compare: TListSortCompare);
asm
  sub edx, 1           // if (List<>nil) and (Count>1) then begin;
  jle @NoSort
  test eax, eax
  jz @NoSort
 
  push ebx
  push esi
  push edi
  push ebp
 
  //   L,   R,   I,  J, Compare
  //  ebx [esp] esi edi ebp
 
  mov ebp, ecx         // Compare
  mov ebx, eax         // L:=cardinal(@List[0]);
  lea edi, [eax+edx*SOP] // J:=R;
  push edi             // R:=cardinal(@List[Count-1]);
 
  cmp edx, InsLast // if Count-1>InsLast then begin;
  jle @QuickSortDone
 
  mov edx, edi
  lea edi, [eax+InsLast*SOP] // J:=cardinal(@List[InsLast]);
  call QuickSortSha_0AA_ASM // QuickSortSha_0AA_ASM(L, R, Compare);
 
@QuickSortDone:
  mov esi, ebx         // I:=L;
@FindMin:
  mov edx, [esi]
  mov eax, [edi]
  sub edi, SOP         // dec(J,SOP);
  call ebp             // if Compare(ppointer(J)^, ppointer(I)^)<0 then I:=J;
  test eax, eax
  jnl @NotMin
  lea esi, [edi+SOP]
@NotMin:
  cmp ebx, edi         // until J<=L;
  jb @FindMin
 
  mov eax, [esi]       // Temp:=pcardinal(I)^;
  mov edx, [ebx]
  mov [esi], edx       // pcardinal(I)^:=pcardinal(L)^;
  mov [ebx], eax       // pcardinal(L)^:=Temp;
 
  lea edi, [ebx+SOP]   // J:=L+SOP;
  lea eax, [eax+eax]   // nop
@Scan:
  cmp edi, [esp]
  jnb @Done            // if J>=R then exit;
 
  mov eax, [edi+SOP]
  mov edx, [edi]
  call ebp
  add edi, SOP         // inc(J,SOP);
  test eax, eax
  jnl @Scan            // until Compare(ppointer(J)^,ppointer(J+MSOP)^)<0;
 
  lea esi, [edi-SOP]   // I:=J-SOP;
  mov ebx, [edi]       // L:=pcardinal(J)^;
 
  nop
@Shift:
  mov edx, [esi-SOP]
  mov eax, [esi]       // pcardinal(I+SOP)^:=pcardinal(I)^;
  mov [esi+SOP], eax
  mov eax, ebx
  call ebp
  sub esi, SOP         // dec(I,SOP);
  test eax, eax
  jl @Shift            // until not (Compare(pointer(L),ppointer(I)^)<0);
 
  mov [esi+SOP], ebx   // pcardinal(I+SOP)^:=L;
  jmp @Scan
 
@Done:
  pop ecx
  pop ebp
  pop edi
  pop esi
  pop ebx
@NoSort:
  end;

Во-вторых, чтобы использовать ассемблерный вариант QuickSort в дальнейших исследованиях. Заметим, что эта процедура не является калькой c предыдущих, в ней, например, нет рекурсии.

Ну, и в-третьих, чтобы убедиться, что компилятор Delphi с задачей справился. Скорость работы всех процедур сезона дымов практически одинакова. А это значит, что для нового ускорения нужны новые идеи.

Потому что два лучше, чем один?

А три лучше, чем два? Мы вплотную подошли к новой старой и весьма интригующей идее многоопорной сортировки. Устоит ли в соревновании с ней отшлифованный временем алгоритм быстрой сортировки?

Понятно, что при каждом вызове трехопорной сортировки массив разбивается на четыре части. Но это не эквивалентно трем вызовам процедуры QuickSort, т.к. в этом случае заранее неизвестно конечное положение медианы, и из-за проблемы полосатого флага неизбежно вырастет количество обменов элементов. Кроме того, деление массива на четыре части, а не на две, не гарантирует выбор оптимального момента переключения на сортировку вставками. Таким образом, трехопорные сортировки отпадают сразу.

Поэтому далее мы ограничимся алгоритмами двухопорной сортировки. Рассмотрим известные реализации, которые опубликовали Robert Sedgewick и Владимир Ярославский, предложим собственный усовершенствованный вариант и сравним их с классическим алгоритмом QuickSort.

Надо сказать, я не уверен, что в точности воспроизвел алгоритм, который описал Robert Sedgewick. Псевдокод его алгоритма приведен ниже.

// Author Robert Sedgewick (Program 5.1 from his dissertation "Quicksort")
Program 5.1
procedure quicksort (integer value L, R);
     if R-L >= M then
          if A[L] > A[R] then A[L] :=: A[R] endif;
          I := I1 := L; V1 := A[L];
          J := J1 := R; V2 := A[R];
          loop until pointers have met:
               loop: I := I+1;
               while A[I] <= V2:
                    if A[I] < V1 then
                         A[I1] := A[I];
                         I1 := I1+1;
                         A[I] := A[I1];
                         if I >= J then pointers have met endif;
                    endif;
               repeat;
               loop: J := J-1;
               while A[J] >= V1:
                    if A[J] > V2 then
                         A[J1] := A[J];
                         J1 := J1-1;
                         A[J] := A[J1];
                         if I >= J then pointers have met endif;
                    endif;
               repeat;
               A[I1] := A[J];
               A[J1] := A[I];
               I1 := I1+1;
               J1 := J1-1;
               A[I] := A[I1];
               A[J] := A[J1];
          repeat;
          A[I1] := V1;
          A[J1] := V2;
          quicksort (L, I1-1);
          quicksort (I1+1, J1-1);
          quicksort (J1+1, R);
     endif;

При переводе на Pascal мне пришлось внести в код некоторые изменения из-за того, что всякий раз, когда я пытался написать что-то, на мой взгляд, более близкое к оригиналу, сортировка массивов (1,3,0,2) и (1,3,0,0,2) выполнялась неверно.

// Author Robert Sedgewick (Program 5.1 from his dissertation "Quicksort")
// Translated to Pascal by Aleksandr Sharahov
procedure DualPivotQuicksortSedgInternal(List: PPointerList; L, R: Integer; Compare: TListSortCompare);
var
  Left, Right, I, J, M: Integer;
  P, Q, T: Pointer;
label
  Done;
begin;
  while true do begin;
    if R-L<=InsLast then exit;  
    I:=(R-L) div 6;
    Left:=L;
    Right:=R;
    L:=L+I;
    R:=R-I;
    M:=L+2*I;
    J:=R-I;
    I:=L+I;
 
    if Compare(List[J], List[I])<0 then begin;
      T:=List[I]; List[I]:=List[J]; List[J]:=T; 
      end;
    if Compare(List[M], List[I])<0 then begin;
      T:=List[I]; List[I]:=List[M]; List[M]:=T;   
      end
    else if Compare(List[J], List[M])<0 then begin;
      T:=List[M]; List[M]:=List[J]; List[J]:=T;            
      end;
 
    if Compare(List[R], List[L])<0 then begin;
      T:=List[L]; List[L]:=List[R]; List[R]:=T;     
      end;
    if Compare(List[I], List[L])<0 then begin;
      T:=List[L]; List[L]:=List[I]; List[I]:=T;    
      end;
    if Compare(List[R], List[J])<0 then begin;
      T:=List[J]; List[J]:=List[R]; List[R]:=T;   
      end;
 
    if Compare(List[J], List[I])<0 then begin;
      T:=List[I]; List[I]:=List[J]; List[J]:=T;    
      end;
    if Compare(List[M], List[I])<0 then begin;
      T:=List[I]; List[I]:=List[M]; List[M]:=T;  
      end
    else if Compare(List[J], List[M])<0 then begin;
      T:=List[M]; List[M]:=List[J]; List[J]:=T;   
      end;
 
    P:=List[I]; Q:=List[J];
 
    if not (Compare(P, Q)<0) then begin;                        // equal pivots
 
      if Compare(List[Right], List[Left])<0 then begin;
        T:=List[Left]; List[Left]:=List[Right]; List[Right]:=T; 
        end;
      if Compare(List[L], List[Left])<0 then begin;
        T:=List[Left]; List[Left]:=List[L]; List[L]:=T;  
        end;
      if Compare(List[Right], List[R])<0 then begin;
        T:=List[R]; List[R]:=List[Right]; List[Right]:=T;  
        end;
 
      I:=Left;  L:=I;
      J:=Right; R:=J;
      repeat; Inc(I); until not (Compare(List[I], P)<0);
      repeat; Dec(J); until not (Compare(P, List[J])<0);
      if I<J then repeat;
        T:=List[I]; List[I]:=List[J]; List[J]:=T;    
        repeat; Inc(I); until not (Compare(List[I], P)<0);
        repeat; Dec(J); until not (Compare(P, 0);
    if IList[J/h1])<0);
        until I>=J;
      dec(I); inc(J);
 
      if I-L<R-J then begin;
        if I-InsLast>L then DualPivotQuicksortSedgInternal(List,L,I,Compare);
        L:=J;
        end
      else begin;
        if J+InsLast<R then DualPivotQuicksortSedgInternal(List,J,R,Compare);
        R:=I;
        end;
      if R-L>InsLast then continue;
      break;
      end;
 
    L:=Left;
    while Compare(List[L], P)<0 do inc(L);                      // [Left..L-1] < P, [L] - left hole
    List[I]:=List[L];        
 
    R:=Right;
    while Compare(Q, List[R])<0 do dec(R);                      // Q < [R+1..Right], [R] - right hole
    List[J]:=List[R];    
 
    I:=L;
    J:=R;
    while true do begin; // [Left..L-1] < P,  P <= [L+1..I] <= Q,  P <= [J..R-1] <= Q,  Q < [R+1..Right]
      while true do begin;
        inc(I); if I>=J then goto Done;                         // >= !!!Sha: here [J] is tested element
        if Compare(List[I], P)<0 then begin;                    // [I] < P
          List[L]:=List[I]; inc(L); List[I]:=List[L];   
          end
        else if Compare(Q, List[I])<0 then break;               // [I] > Q
        end;
      while true do begin;
        dec(J); if I>J then goto Done;                          // > !!!Sha: here [I] is element to exchange
        if Compare(Q, List[J])<0 then begin;                    // [J] > Q
          List[R]:=List[J]; dec(R); List[J]:=List[R]; 
          end
        else if Compare(List[J], P)<0 then break;               // [J] < P
        end;
      List[L]:=List[J]; inc(L);
      List[R]:=List[I]; dec(R); 
      List[I]:=List[L];
      List[J]:=List[R];       
      end;
Done:
    List[L]:=P;
    List[R]:=Q;
 
    DualPivotQuicksortSedgInternal(List, Left, L-1, Compare);
    DualPivotQuicksortSedgInternal(List, R+1, Right, Compare);
    inc(L); dec(R); //DualPivotQuicksortSedgInternal(List, L+1, R-1, Compare);
    end;
  end;
 
procedure DualPivotQuicksortSedg(List: PPointerList; Count: Integer; Compare: TListSortCompare);
begin;
  if (List<>nil) and (Count>1) then begin;
    Count:=Count-1;
    if Count>InsLast then DualPivotQuicksortSedgInternal(List, 0, Count, Compare);
    InsertionSortSha(List, Count, Compare);
    end;
  end;

Алгоритм двухопорной сортировки Владимира Ярославского был взят с его сайта
http://iaroslavski.narod.ru/quicksort/

// Author Vladimir Yaroslavskiy (original version 2009.09.17 m765.817)
// Translated to Pascal by Aleksandr Sharahov
procedure DualPivotQuicksort817Internal(a: PPointerList; left, right: Integer; Compare: TListSortCompare);
const
  DIST_SIZE = 13;
  TINY_SIZE = InsCount;
var
  len, i, j: integer;
  sixth, m1, m2, m3, m4, m5: integer;
  less, great, k: integer;
  x, pivot1, pivot2: pointer;
  diffPivots: boolean;
begin;
  len:=right - left;
 
  // insertion sort on tiny array
  if len<TINY_SIZE then begin;
    for i:=left+1 to right do begin;
      for j:=i downto left+1 do begin;
        if not (Compare(a[j], a[j-1])<0) then break;
        x:=a[j-1]; a[j-1]:=a[j]; a[j]:=x;   
        end;
      end;
    exit;
    end;
 
  // median indexes
  sixth:=len div 6;   
  m1:=left + sixth;
  m2:=m1 + sixth;
  m3:=m2 + sixth;
  m4:=m3 + sixth;
  m5:=m4 + sixth;
 
  // 5-element sorting network
  if Compare(a[m2], a[m1])<0 then begin; x:=a[m1]; a[m1]:=a[m2]; a[m2]:=x; end;
  if Compare(a[m5], a[m4])<0 then begin; x:=a[m4]; a[m4]:=a[m5]; a[m5]:=x; end;
  if Compare(a[m3], a[m1])<0 then begin; x:=a[m1]; a[m1]:=a[m3]; a[m3]:=x; end;
  if Compare(a[m3], a[m2])<0 then begin; x:=a[m2]; a[m2]:=a[m3]; a[m3]:=x; end;
  if Compare(a[m4], a[m1])<0 then begin; x:=a[m1]; a[m1]:=a[m4]; a[m4]:=x; end;
  if Compare(a[m4], a[m3])<0 then begin; x:=a[m3]; a[m3]:=a[m4]; a[m4]:=x; end;
  if Compare(a[m5], a[m2])<0 then begin; x:=a[m2]; a[m2]:=a[m5]; a[m5]:=x; end;
  if Compare(a[m3], a[m2])<0 then begin; x:=a[m2]; a[m2]:=a[m3]; a[m3]:=x; end;
  if Compare(a[m5], a[m4])<0 then begin; x:=a[m4]; a[m4]:=a[m5]; a[m5]:=x; end;
 
  // pivots: [ < pivot1 | pivot1 <= && <= pivot2 | > pivot2 ]
  pivot1:=a[m2];
  pivot2:=a[m4];
  diffPivots:=Compare(pivot1, pivot2)<>0;
  a[m2]:=a[left];
  a[m4]:=a[right];   
 
  // center part pointers
  less:=left + 1;
  great:=right - 1;
 
  // sorting
  if diffPivots then begin;
    k:=less;
    while k<=great do begin;
      x:=a[k];
      if Compare(x, pivot1)<0 then begin;
        a[k]:=a[less]; a[less]:=x; less:=less+1;  
        end
      else if Compare(pivot2, x)<0 then begin;
        while (k<great) and (Compare(pivot2, a[great])<0) do great:=great-1;
        a[k]:=a[great]; a[great]:=x; great:=great-1;  
        x:=a[k];
        if Compare(x, pivot1)<0 then begin;
          a[k]:=a[less]; a[less]:=x; less:=less+1; 
          end;
        end;
      k:=k+1;
      end;
    end
  else begin;
    k:=less;
    while k<=great do begin;
      x:=a[k];
      if Compare(x, pivot1)=0 then {nothing}
      else if Compare(x, pivot1)<0 then begin;
        a[k]:=a[less]; a[less]:=x; less:=less+1; 
        end
      else begin;
        while (k<great) and (Compare(pivot2, a[great])<0) do great:=great-1;
        a[k]:=a[great]; a[great]:=x; great:=great-1; 
        x:=a[k];
        if Compare(x, pivot1)<0 then begin;
          a[k]:=a[less]; a[less]:=x; less:=less+1;   
          end;
        end;
      k:=k+1;
      end;
    end;
 
  // swap
  a[left]:=a[less-1]; a[less-1]:=pivot1;
  a[right]:=a[great+1]; a[great+1]:=pivot2;   
 
  // left and right parts
  DualPivotQuicksort817Internal(a, left,   less - 2, Compare);
  DualPivotQuicksort817Internal(a, great + 2, right, Compare);
 
  // equal elements
  if diffPivots and (great-less > len-DIST_SIZE) then begin;
    k:=less;
    while k<=great do begin;
      x:=a[k];
      if Compare(x, pivot1)=0 then begin;
        a[k]:=a[less]; a[less]:=x; less:=less+1;     
        end
      else if Compare(x, pivot2)=0 then begin;
        a[k]:=a[great]; a[great]:=x; great:=great-1; 
        x:=a[k];
        if Compare(x, pivot1)=0 then begin;
          a[k]:=a[less]; a[less]:=x; less:=less+1;   
          end;
        end;
      k:=k+1;
      end;
    end;
 
  // center part
  if diffPivots then DualPivotQuicksort817Internal(a, less, great, Compare);
  end;
 
procedure DualPivotQuicksort817(List: PPointerList; Count: Integer; Compare: TListSortCompare);
begin;
  if (List<>nil) and (Count>1) then DualPivotQuicksort817Internal(List, 0, Count-1, Compare);
  end;

А вот наш рояль в кустах:

// Author Aleksandr Sharahov
procedure DualPivotQuicksortShaInternal(List: PPointerList; L, R: Integer; Compare: TListSortCompare);
var
  Left, Right, I, J, M: Integer;
  P, Q, T: Pointer;
begin;
  if R-L>InsLast then while true do begin;  
    I:=(R-L) div 6;
    Left:=L;
    Right:=R;
    L:=L+I;
    R:=R-I;
    M:=L+2*I;
    J:=R-I;
    I:=L+I;
 
    if Compare(List[J], List[I])<0 then begin;
      T:=List[I]; List[I]:=List[J]; List[J]:=T; 
      end;
    if Compare(List[M], List[I])<0 then begin;
      T:=List[I]; List[I]:=List[M]; List[M]:=T;  
      end
    else if Compare(List[J], List[M])<0 then begin;
      T:=List[M]; List[M]:=List[J]; List[J]:=T; 
      end;
 
    if Compare(List[R], List[L])<0 then begin;
      T:=List[L]; List[L]:=List[R]; List[R]:=T; 
      end;
    if Compare(List[I], List[L])<0 then begin;
      T:=List[L]; List[L]:=List[I]; List[I]:=T; 
      end;
    if Compare(List[R], List[J])<0 then begin;
      T:=List[J]; List[J]:=List[R]; List[R]:=T;  
      end;
 
    if Compare(List[J], List[I])<0 then begin;
      T:=List[I]; List[I]:=List[J]; List[J]:=T;  
      end;
    if Compare(List[M], List[I])<0 then begin;
      T:=List[I]; List[I]:=List[M]; List[M]:=T;   
      end
    else if Compare(List[J], List[M])<0 then begin;
      T:=List[M]; List[M]:=List[J]; List[J]:=T; 
      end;
 
    P:=List[I]; Q:=List[J];
 
    if Compare(P, Q)<0 then begin;                              // different pivots P < Q
      List[I]:=List[Left];
      List[J]:=List[Right];  
 
      I:=Left;
      J:=Right;
      while true do begin;
        repeat; dec(J); until Compare(List[J], Q)<0;            // [J] < Q
        repeat; inc(I); until Compare(P, List[I])<0;            // [I] > P
        L:=I;
        if I>=J then break;
        if Compare(List[I], Q)<0 then break;                    // [I] < Q
        T:=List[J]; List[J]:=List[I]; List[I]:=T; 
        if not Compare(P, T)<0 then continue;                   // [I] <= P
        repeat; dec(J); until Compare(List[J], Q)<0;            // [J] < Q
        break;
        end;
 
      if I<J then while true do begin;         // [L-1] <= P,  P < [I-1] < Q,  [J] < Q,  Q <= [J+1]
        inc(I);
        if not (Compare(P, List[I])<0) then begin;              // [I] <= P
          T:=List[I]; List[I]:=List[L]; List[L]:=T; inc(L); 
          continue;
          end;
        if I>=J then break;
        if Compare(List[I], Q)<0 then continue;                 // P < [I] < Q
        T:=List[J]; List[J]:=List[I];         
        if Compare(P, T)<0 then List[I]:=T                      // T > P
        else begin;
          List[I]:=List[L]; List[L]:=T; inc(L);  
          end;
        repeat; dec(J); until Compare(List[J], Q)<0;            // [J] < Q
        if I>=J then break;
        end;
 
      List[Left]:=List[L-1]; List[L-1]:=P;
      List[Right]:=List[J+1]; List[J+1]:=Q;  
 
      if L-Left<Right-J then begin;
        DualPivotQuicksortShaInternal(List, Left, L-2, Compare);
        DualPivotQuicksortShaInternal(List, J+2, Right, Compare);
        R:=J;
        if J-L>InsLast then continue;
        end
      else begin;
        DualPivotQuicksortShaInternal(List, J+2, Right, Compare);
        DualPivotQuicksortShaInternal(List, Left, L-2, Compare);
        R:=J;
        if J-L>InsLast then continue;
        end;
      end
 
    else begin;                                                 // equal pivots P >= Q
      if Compare(List[Right], List[Left])<0 then begin;
        T:=List[Left]; List[Left]:=List[Right]; List[Right]:=T; 
        end;
      if Compare(List[L], List[Left])<0 then begin;
        T:=List[Left]; List[Left]:=List[L]; List[L]:=T;  
        end;
      if Compare(List[Right], List[R])<0 then begin;
        T:=List[R]; List[R]:=List[Right]; List[Right]:=T;  
        end;
 
      I:=Left;  L:=I;
      J:=Right; R:=J;
      repeat; Inc(I); until not (Compare(List[I], P)<0);
      repeat; Dec(J); until not (Compare(P, List[J])<0);
      if I<J then repeat;
        T:=List[I]; List[I]:=List[J]; List[J]:=T;      
        repeat; Inc(I); until not (Compare(List[I], P)<0);
        repeat; Dec(J); until not (Compare(P, List[J])<0);
        until I>=J;
      dec(I); inc(J);
 
      if I-L<R-J then begin;
        if I-InsLast>L then DualPivotQuicksortShaInternal(List,L,I,Compare);
        L:=J;
        if R-J>InsLast then continue;
        end
      else begin;
        if J+InsLast<R then DualPivotQuicksortShaInternal(List,J,R,Compare);
        R:=I;
        if I-L>InsLast then continue;
        end;
      end;
 
    break;
    end;
  end;
 
procedure DualPivotQuicksortSha(List: PPointerList; Count: Integer; Compare: TListSortCompare);
begin;
  if (List<>nil) and (Count>1) then begin;
    Count:=Count-1;
    if Count>InsLast then DualPivotQuicksortShaInternal(List, 0, Count, Compare);
    InsertionSortSha(List, Count, Compare);
    end;
  end;

Главная особенность алгоритма DualPivotQuicksortSha заключается в том, что он, как и QuickSort, отслеживает совпадение встречно изменяющихся индексов без больших затрат времени. В его внутренних циклах нет проверки совпадения индексов. Для снижения числа перестановок, если это возможно, применяется тройной обмен. Дополнительно снижению числа перестановок упорядоченных данных способствует их обработка на предварительной фазе, а также выбор симметричных индексов для опорных элементов.

Процедура DualPivotQuicksortSha в случае равенства опорных элементов переключается на стандартный алгоритм быстрой сортировки. Поэтому в качестве заготовки для ассемблерной версии как нельзя лучше подойдет процедура HybridSortSha_0AA_Asm. После внесения в нее необходимых добавлений алгоритм на ассемблере выглядит так:

procedure DualPivotQuicksortShaAsmInternal(L, R: pointer; Compare: TListSortCompare);
var
  CompareFunc: TListSortCompare;
  Delta: cardinal;
  M, P, Q: Pointer;
asm
//  compiler generated stack frame below
//  push ebp
//  mov ebp, esp
//  add esp, -$14
 
  push ebx
  push esi
  push edi
  push -1              // end stack mark
  push 0               // end stack mark
 
  mov CompareFunc, ecx
 
@DoParts:
  mov ecx, [esp+4]
  sub ecx, [esp]       // next part size
  mov ebx, edx
  sub ebx, eax         // current part size
  cmp ebx, ecx
  mov esi, eax         // I:=L;
  mov edi, edx         // J:=R;
  jbe @Small           // need smallest part
 
  pop esi              // exchange parts
  pop edi
  push edx
  push eax
  mov ebx, ecx         // new part size
 
@Small:
  cmp ebx, InsLast * SOP // if J-I<=InsLast * SOP then break;
  ja @Split
 
  pop eax              // new current part
  pop edx
  test eax, eax        // is end mark?
  jnz @DoParts
 
  pop edi
  pop esi
  pop ebx
  mov esp, ebp
  pop ebp
  ret
 
@Split:
  push edi             // save current part bounds
  push esi
 
  shr ebx, 1
  mov eax, ebx
  xor edx, edx
  mov ecx, 3
  div ecx
 
  and ebx, MSOP
  add ebx, esi         // T:=(J-I) shr 1 and MSOP + I;
  mov M, ebx
 
  and eax, MSOP
  mov Delta, eax       // Delta:=(R-L) div 6;
 
@Sort1:                // Sort medians: m2, m3, m4 (esi, ebx, edi)
  add eax, eax
  sub edi, eax
  add esi, eax
 
  mov eax, [edi]
  mov edx, [esi]
  call CompareFunc
  test eax, eax
  jge @Ok11            // if Compare(List[J], List[I])<0 then begin;
 
  mov eax, [esi]       // T:=List[I]; List[I]:=List[J]; List[J]:=T;
  mov edx, [edi]
  mov [esi], edx
  mov [edi], eax
 
@Ok11:
  mov eax, [ebx]
  mov edx, [esi]
  call CompareFunc
  test eax, eax
  jge @Ok12            // if Compare(List[M], List[I])<0 then begin;
 
  mov eax, [ebx]       // T:=List[I]; List[I]:=List[M]; List[M]:=T;
  mov edx, [esi]
  mov [ebx], edx
  mov [esi], eax
  jmp @Ok13
 
@Ok12:
  mov eax, [edi]
  mov edx, [ebx]
  call CompareFunc
  test eax, eax
  jge @Ok13            // else if Compare(List[J], List[M])<0 then begin;
 
  mov eax, [edi]       // T:=List[M]; List[M]:=List[J]; List[J]:=T;
  mov edx, [ebx]
  mov [edi], edx
  mov [ebx], eax
@Ok13:
 
@Sort2:                // Sort medians: m1, m2, m4, m5 (esi, esi+ebx, edi, edi+ebx)
  mov ebx, Delta
  sub esi, ebx
 
  mov eax, [edi+ebx]
  mov edx, [esi]
  call CompareFunc
  test eax, eax
  jge @Ok21            // if Compare(List[R], List[L])<0 then begin;
 
  mov eax, [esi]       // T:=List[L]; List[L]:=List[R]; List[R]:=T;
  mov edx, [edi+ebx]
  mov [esi], edx
  mov [edi+ebx], eax
 
@Ok21:
  mov eax, [esi+ebx]
  mov edx, [esi]
  call CompareFunc
  test eax, eax
  jge @Ok22            // if Compare(List[I], List[L])<0 then begin;
 
  mov eax, [esi+ebx]   // T:=List[L]; List[L]:=List[I]; List[I]:=T;
  mov edx, [esi]
  mov [esi+ebx], edx
  mov [esi], eax
 
@Ok22:
  mov eax, [edi+ebx]
  mov edx, [edi]
  call CompareFunc
  test eax, eax
  jge @Ok23            // if Compare(List[R], List[J])<0 then begin;
 
  mov eax, [edi+ebx]   // T:=List[J]; List[J]:=List[R]; List[R]:=T;
  mov edx, [edi]
  mov [edi+ebx], edx
  mov [edi], eax
@Ok23:
 
@Sort3:                // Sort medians: m2, m3, m4 (esi, ebx, edi)
  add esi, ebx
  mov ebx, M
 
  mov eax, [edi]
  mov edx, [esi]
  call CompareFunc
  test eax, eax
  jge @Ok31            // if Compare(List[J], List[I])<0 then begin;
 
  mov eax, [esi]       // T:=List[I]; List[I]:=List[J]; List[J]:=T;
  mov edx, [edi]
  mov [esi], edx
  mov [edi], eax
 
@Ok31:
  mov eax, [ebx]
  mov edx, [esi]
  call CompareFunc
  test eax, eax
  jge @Ok32            // if Compare(List[M], List[I])<0 then begin;
 
  mov eax, [ebx]       // T:=List[I]; List[I]:=List[M]; List[M]:=T;
  mov edx, [esi]
  mov [ebx], edx
  mov [esi], eax
  jmp @Ok33
 
@Ok32:
  mov eax, [edi]
  mov edx, [ebx]
  call CompareFunc
  test eax, eax
  jge @Ok33            // else if Compare(List[J], List[M])<0 then begin;
 
  mov eax, [edi]       // T:=List[M]; List[M]:=List[J]; List[J]:=T;
  mov edx, [ebx]
  mov [edi], edx
  mov [ebx], eax
@Ok33:
 
  mov eax, [esi]
  mov edx, [edi]
  mov P, eax            // P:=List[I]; Q:=List[J];
  mov Q, edx
  call CompareFunc
  test eax, eax
  jge @EqualPivots      // if Compare(P, Q)<0 then begin;
 
  // Left, Right,  I,  J,  L
  // [esp][esp+4] esi edi ebx
 
@DifferentPivots:
  mov edx, [esp+4]
  mov ecx, [esp]
  mov eax, [edx]
  mov [edi], eax        // List[J]:=List[Right];
  mov eax, [ecx]
  mov [esi], eax        // List[I]:=List[Left];
 
  mov edi, edx          // J:=Right;
  mov esi, ecx          // I:=Left;
 
@Phase1:
@LoopJ:
  sub edi, SOP          // dec(J);
  mov eax, [edi]
  mov edx, Q
  call CompareFunc
  test eax, eax
  jge @LoopJ            // until Compare(List[J], Q)<0;
 
@LoopI:
  add esi, SOP          // inc(I);
  mov eax, P
  mov edx, [esi]
  call CompareFunc
  test eax, eax
  jge @LoopI            // until Compare(P, List[I])<0;
 
  mov ebx, esi          // L:=I;
  cmp esi, edi
  jae @Phase2           // if I>=J then break;
 
  mov eax, [esi]
  mov edx, Q
  call CompareFunc
  test eax, eax
  jl @Phase2            // if Compare(List[I], Q)<0 then break;
 
  mov edx, [edi]        // T:=List[J]; List[J]:=List[I]; List[I]:=T;
  mov eax, [esi]
  mov [esi], edx
  mov [edi], eax
  mov eax, P
  call CompareFunc
  test eax, eax
  jge @Phase1           // if not Compare(P, T)<0 then continue;
 
@LoopJ2:
  sub edi, SOP          // dec(J);
  mov eax, [edi]
  mov edx, Q
  call CompareFunc
  test eax, eax
  jge @LoopJ2           // until Compare(List[J], Q)<0;
 
@Phase2:                // [L-1] <= P,  P < [I-1] < Q,  [J] < Q,  Q <= [J+1]
  cmp esi, edi
  jae @InsertPivots     // if I<J then while true do begin;
 
@MainLoop:
  add esi, SOP          // inc(I);
  mov eax, P
  mov edx, [esi]
  call CompareFunc
  test eax, eax
  jl @NotSmall          // if not (Compare(P, List[I])<0) then begin;              // [I] <= P
 
  mov edx, [ebx]        // T:=List[I]; List[I]:=List[L]; List[L]:=T;
  mov eax, [esi]
  mov [esi], edx
  mov [ebx], eax
  add ebx, SOP          // inc(L);
  jmp @MainLoop         // continue;
 
@NotSmall:
  cmp esi, edi
  jae @InsertPivots     // if I>=J then break;
 
  mov eax, [esi]
  mov edx, Q
  call CompareFunc
  test eax, eax
  jl @MainLoop          // if Compare(List[I], Q)<0 then continue;                 // P < [I] < Q
 
  mov eax, P
  mov edx, [edi]
  call CompareFunc
  test eax, eax
  jge @Triplet          // if Compare(P, List[J])<0 then
 
  mov edx, [edi]        // T:=List[J]; List[J]:=List[I]; List[I]:=T
  mov eax, [esi]
  mov [esi], edx
  mov [edi], eax
  jmp @DupletTriplet
 
@Triplet:
  mov edx, [edi]        // T:=List[J]; List[J]:=List[I]; List[I]:=List[L]; List[L]:=T;
  mov eax, [esi]
  mov [edi], eax
  mov eax, [ebx]
  mov [esi], eax
  mov [ebx], edx
  add ebx, SOP          // inc(L);
@DupletTriplet:
 
@LoopJ3:
  sub edi, SOP          // dec(J);
  mov eax, [edi]
  mov edx, Q
  call CompareFunc
  test eax, eax
  jge @LoopJ3           // until Compare(List[J], Q)<0;                            // [J] < Q
 
  cmp esi, edi
  jl @MainLoop          // if I>=J then break;
 
@InsertPivots:
  mov edx, [esp+4]      // Right
  mov ecx, [esp]        // Left
 
  mov eax, [edi+SOP]    // List[Right]:=List[J+1]; List[J+1]:=Q;
  mov [edx], eax
  mov eax, Q
  mov [edi+SOP], eax
 
  mov eax, [ebx-SOP]    // List[Left]:=List[L-1]; List[L-1]:=P;
  mov [ecx], eax
  mov eax, P
  mov [ebx-SOP], eax
 
  lea eax, [edi+2*SOP] // DualPivotQuicksortShaInternal(List, J+2, Right, Compare);
  mov [esp], eax
 
  mov eax, ecx         // DualPivotQuicksortShaInternal(List, Left, L-2, Compare);
  lea edx, [ebx-2*SOP]
 
  cmp ebx, edi         // if L<J
  jae @DoParts
 
  push edi             // then DualPivotQuicksortShaInternal(List, L, J, Compare);
  push ebx
  jmp @DoParts
 
  //   L,    R,    I,  J,  P
  // [esp][esp+4] esi edi ebx
 
@EqualPivots:
  mov esi, [esp]
  mov edi, [esp+4]
 
  mov eax, [edi]
  mov edx, [esi]
  call CompareFunc
  test eax, eax
  jge @OkLR            // if Compare(ppointer(J)^, ppointer(I)^)<0 then begin;
 
  mov eax, [esi]       // P:=pcardinal(I)^; pcardinal(I)^:=pcardinal(J)^; pcardinal(J)^:=P;
  mov edx, [edi]
  mov [esi], edx
  mov [edi], eax
 
@OkLR:
  mov eax, [ebx]
  mov edx, [esi]
  call CompareFunc
  test eax, eax
  jge @OkLM            // if Compare(ppointer(T), ppointer(I)^)<0 then begin;
 
  mov eax, [ebx]       // P:=pcardinal(I)^; pcardinal(I)^:=pcardinal(T)^; pcardinal(T)^:=P;
  mov edx, [esi]
  mov [ebx], edx
  mov [esi], eax
  jmp @OkMR
 
@OkLM:
  mov eax, [edi]
  mov edx, [ebx]
  call CompareFunc
  test eax, eax
  jge @OkMR            // else if Compare(ppointer(J)^, pointer(P))<0 then begin;
 
  mov eax, [edi]       // P:=pcardinal(J)^; pcardinal(J)^:=pcardinal(T)^; pcardinal(T)^:=P;
  mov edx, [ebx]
  mov [edi], edx
  mov [ebx], eax
 
@OkMR:
  mov ebx, [ebx]       // P:=pcardinal(T)^;
 
@FindLeft1:            // repeat; Inc(I,SOP); until not (Compare(ppointer(I)^, pointer(P))<0);
  add esi, SOP
  mov eax, [esi]
  mov edx, ebx
  call CompareFunc
  test eax, eax
  jl @FindLeft1
 
@FindRight1:           // repeat; Dec(J,SOP); until not (Compare(pointer(P), ppointer(J)^)<0);
  sub edi, SOP
  mov edx, [edi]
  mov eax, ebx
  call CompareFunc
  test eax, eax
  jl @FindRight1
 
  cmp esi, edi
  jae @ExchangesDone   // if I<J then repeat;
 
@Exchange:             // T:=pcardinal(I)^; pcardinal(I)^:=pcardinal(J)^; pcardinal(J)^:=T;
  mov eax, [esi]
  mov edx, [edi]
  mov [esi], edx
  mov [edi], eax
 
@FindLeft2:            // repeat; Inc(I,SOP); until not (Compare(ppointer(I)^, pointer(P))<0);
  add esi, SOP
  mov eax, [esi]
  mov edx, ebx
  call CompareFunc
  test eax, eax
  jl @FindLeft2
 
@FindRight2:           // repeat; Dec(J,SOP); until not (Compare(pointer(P), ppointer(J)^)<0);
  sub edi, SOP
  mov edx, [edi]
  mov eax, ebx
  call CompareFunc
  test eax, eax
  jl @FindRight2
 
  cmp esi, edi
  jb @Exchange         // until I>=J;
 
@ExchangesDone:
  sub esi, SOP         // Dec(I,SOP); Inc(J,SOP);
  add edi, SOP
  mov eax, [esp]
  mov [esp], edi       // DualPivotQuicksortShaAsmInternal(J, R, Compare);
  mov edx, esi         // DualPivotQuicksortShaAsmInternal(L, I, Compare);
  jmp @DoParts
  end;
 
//~1.47 times faster than Delphi QuickSort on E6850
procedure DualPivotQuicksortShaAsm(List: PPointerList; Count: integer; Compare: TListSortCompare);
asm
  sub edx, 1           // if (List<>nil) and (Count>1) then begin;
  jle @NoSort
  test eax, eax
  jz @NoSort
 
  push ebx
  push esi
  push edi
  push ebp
 
  //   L,   R,   I,  J, Compare
  //  ebx [esp] esi edi ebp
 
  mov ebp, ecx         // Compare
  mov ebx, eax         // L:=cardinal(@List[0]);
  lea edi, [eax+edx*SOP] // J:=R;
  push edi             // R:=cardinal(@List[Count-1]);
 
  cmp edx, InsLast     // if Count-1>InsLast then begin;
  jle @QuickSortDone
 
  mov edx, edi
  lea edi, [eax+InsLast*SOP] // J:=cardinal(@List[InsLast]);
  call DualPivotQuicksortShaAsmInternal // DualPivotQuicksortShaAsmInternal(L, R, Compare);
 
@QuickSortDone:
  mov esi, ebx         // I:=L;
@FindMin:
  mov edx, [esi]
  mov eax, [edi]
  sub edi, SOP         // dec(J,SOP);
  call ebp             // if Compare(ppointer(J)^, ppointer(I)^)<0 then I:=J;
  test eax, eax
  jnl @NotMin
  lea esi, [edi+SOP]
@NotMin:
  cmp ebx, edi         // until J<=L;
  jb @FindMin
 
  mov eax, [esi]       // Temp:=pcardinal(I)^;
  mov edx, [ebx]
  mov [esi], edx       // pcardinal(I)^:=pcardinal(L)^;
  mov [ebx], eax       // pcardinal(L)^:=Temp;
 
  lea edi, [ebx+SOP]   // J:=L+SOP;
  lea eax, [eax+eax]   // nop
@Scan:
  cmp edi, [esp]
  jnb @Done            // if J>=R then exit;
 
  mov eax, [edi+SOP]
  mov edx, [edi]
  call ebp
  add edi, SOP         // inc(J,SOP);
  test eax, eax
  jnl @Scan            // until Compare(ppointer(J)^,ppointer(J+MSOP)^)<0;
 
  lea esi, [edi-SOP]   // I:=J-SOP;
  mov ebx, [edi]       // L:=pcardinal(J)^;
 
  nop
@Shift:
  mov edx, [esi-SOP]
  mov eax, [esi]       // pcardinal(I+SOP)^:=pcardinal(I)^;
  mov [esi+SOP], eax
  mov eax, ebx
  call ebp
  sub esi, SOP         // dec(I,SOP);
  test eax, eax
  jl @Shift            // until not (Compare(pointer(L),ppointer(I)^)<0);
 
  mov [esi+SOP], ebx   // pcardinal(I+SOP)^:=L;
  jmp @Scan
 
@Done:
  pop ecx
  pop ebp
  pop edi
  pop esi
  pop ebx
@NoSort:
  end;

Прежде чем приступить к сравнению алгоритмов, давайте приведем их к общему знаменателю. Во-первых, установим единое значение длины массива (например, 35), при которой они переходят к сортировке вставками. Во-вторых, для двухопорных алгоритмов установим также одинаковое количество пробных элементов (например, 5), из которых выбираются опорные.

Мы не станем выводить многоэтажные формулы, а вместо этого, вспоминая слова о критерии истины, займемся практическим определением количества сравнений и перестановок в исследуемых алгоритмах. Заполним массив из 2^23 элементов случайными целыми числами. Он будет выступать одновременно и в роли списка адресов элементов, и в роли массива значений элементов. Для сравнения элементов такого массива потребуется особенная функция:

function CompareInt(Item1, Item2: Pointer): Integer;
begin;
  if Integer(Item1) < Integer(Item2) then Result := -1
  else if Integer(Item1) > Integer(Item2) then Result := 1
  else Result := 0;
  end;

Разобьем массив на подмассивы случайной длины, которая не более чем на 1/8 отличается от заданной. Наш эксперимент состоит в сортировке всех подмассивов. Полученные результаты приведены в следующей таблице. Левый столбец содержит общее количество сравнений, правый – количество обменов.

  Количество сравнений и обменов (*10^6) при сортировке 
  случайных данных
================================================================
                            2^13 раз      2^8 раз       2^3 раз
 Алгоритм                 ~ 2^10 эл.    ~ 2^15 эл.    ~ 2^20 эл.
----------------------------------------------------------------
 HybridSortSha_AII         558  385      806  485     1048  585
 DualPivotQuicksortSha     528  403      774  549     1026  692
 DualPivotQuicksortSedg    526  465      769  666     1018  867
 DualPivotQuicksort817     517  594      764  755     1016  915

Видно, что тестируемые алгоритмы имеют примерно одинаковое количество вызовов функции сравнения, в то время как количество перестановок элементов у них заметно отличается, причем в пользу классики. В связи с этим шансы двухопорных алгоритмов на первое место по скорости сортировки представляются весьма сомнительными.

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

  Количество сравнений и обменов (*10^6) при сортировке
  упорядоченных данных (2^3 массивов по ~ 2^20 элементов)
==========================================================
 Алгоритм                Прямой порядок  Инверсный порядок
----------------------------------------------------------
 HybridSortSha_AII         672    0        672   42
 DualPivotQuicksortSha     610    7        652   49
 DualPivotQuicksortSedg    612    2        656  169
 DualPivotQuicksort817     604  285        652  340

Здесь алгоритм DualPivotQuicksortSha опять приблизился к классическому по количеству перестановок. Но для победы по времени этого мало, все реализации двухопорной сортировки на Pascal и на BASM проигрывают своим классическим аналогам.

  Время сортировки случайных данных
================================================================
                            2^13 раз      2^8 раз       2^3 раз
 Алгоритм                 ~ 2^10 эл.    ~ 2^15 эл.    ~ 2^20 эл.
----------------------------------------------------------------
 HybridSortSha_0AA_ASM       511           770          1027
 HybridSortSha_0AA           528           784          1041
 HybridSortSha_A0I           533           793          1054
 HybridSortSha_AII           542           805          1070
 DualPivotQuicksortShaAsm    552           840          1130
 DualPivotQuicksortSha       590           892          1192
 DualPivotQuicksortSedg      612           937          1266
 DualPivotQuicksort817       658          1004          1354
 Sort (RTL)                  836          1146          1449

Как видим, результат применения двухопорной сортировки отрицательный. Но от этого знаний у нас не становится меньше.

на главную

Comments (2)

english version

dear author;
do you have your research published in english?

english version

Hello!
Unfortunately, I do not have much time to deal with the translation of my articles.
The text of these articles contains some Russian idioms that can be omitted in the translation without losing the general idea.
And I'll be very grateful if anyone can help with the translation.
--
Sincerely, Aleksandr.