Со времен пузырька человечество безотрывно интересуется скоростью сортировки. В этих заметках его бесценный опыт использован для уменьшения времени работы 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 (4)
а если нужна сортировать
а если нужна сортировать TWordArray = array of word, не integer/cardinal, какие изменения?
сортируйте
Очевидно, что изменения будут те же, что и для любой другой сортировки, например, для сортировки пузырьком.
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.