排序和搜索是我们编程时最常用到的两种算法了，C++程序员们幸运一些，因为在C++标准库中就有各种通用的排序函数；而Delphi程序员就只有TList.Sort和TStringList.Sort可用了，所以Delphi程序员通常都把排序函数加入到自己的常用函数单元中。
作为“通用排序函数”，自然要在“基于比较”的排序算法中选择，而其中的“快速排序”以其效率优势常使它成为程序员的首选。但快速排序也有一个常常另人担心的问题……它在最差情况下的时间复杂度是O(N2)。因此，悲观的程序员们通常会改用“堆排序”（在《C++标准程序库》一书中作者就推荐使用partial_sort，因为sort可能是用“快速排序”实现的而partial_sort则通常是用“堆排序实现的”）。
为了能“既吃到鱼又不丢了熊掌”，很多程序员都在想办法改良“快速排序”，在不影响它的优秀的平均性能的前提下使它在最差情况下也可以获得可以忍受的性能，其中最成功的应该算是“Intro Sort”，而我在这里谈的是另一种方法。
我们知道，“快速排序”的主要思想就是递归地对序列进行划分，用一个枢值把序列分成“大序列”和“小序列”。如果这个划分每次都是平均地“一分为二”，这时它就获得了最佳的性能；而如果每次都是“畸形划分”——把序列分成长度为1和N-1的两部分，它就退化成了递归实现的“冒泡排序”，性能可想而知。要想对它进行改良，就要针对这种情况进行处理。一种思路是对划分进行改良，让它不产生“畸形划分”；另一种思路是对划分结果进行检查，如果是畸形划分则进行特殊处理。我这里的方法是第二种。
基本思路就是，对划分结果产生的两个子序列的长度进行检查，如果其中一个与另一个的长度比超过某一界限，则认为这是一个“畸形划分”，对较短的子序列继续使用“快速排序”，而把较长的子序列平分为两个子序列分别排序，然后再进行一次合并。两个有序序列的合并是可以实现为线性的时间复杂度的，因此可以在每次都是畸形划分时仍然获得O(N*LogN)的时间复杂度。
基本算法描述如下：
procedure Sort(Data, Size);
begin
M := Partition(Data, Size);
MoreData := @Data[M + 1];
MoreSize := Size - M - 1;
Size := M;
if Size > M then
begin
Swap(MoreData, Data);
Swap(MoreSize, Size);
end;
Sort(Data, Size);
if MoreSize div MAX_RATIO > Size then
begin
Sort(MoreData, MoreSize div 2);
Sort(@MoreData[MoreSize div 2], MoreSize - MoreSize div 2);
Merge(MoreData, MoreSize div 2, MoreSize);
end
else
Sort(MoreData, MoreSize);
end;
其中Partition就是众所周知的用于“快速排序”的划分子程序，Merge(Data, First,Size)把Data中[0,First)和[First, Size)两个有序列合并为一个有序序列并存放在Data中。上面的算法认为Partition划分的位置M处的值就是划分的枢值，也就是说序列可以分成[0,M-1]、[M,M]和[M+1,Size-1]三部分。如果Partition的实现不能保证这一点，则MoreData应为Data[M]，而MoreSize也应为Size - M。
现在简单分析一下这个排序，最好情况是在Partition每次划分都是平均划分时，这时合并不会发生，它等同于“快速排序”。而在最差情况下，每次Partition都会把序列分成长度为1和N-1的两部分，这时它就变成了递归实现的“二路归并排序”，但在每次合并前都进行了约N次比较，作用只是分出一个元素不参与合并。因此这个排序的时间复杂度仍然是O(N*LogN)，比较次数大约是归并排序的二倍。
关于MAX_RATIO的选择，根据我的经验，应该是选择4-16之间的数字比较好，我选择的是8。
我实际上实现时比上面说的要复杂一些，一是在序列长度不大于16时改用插入排序，二是去掉了一个递归。然后作了一些效率上的测试，数据是500,000个长度为10的字符串，大致如下：
随机分布，500000个元素：
Sort:时间：3.31；比较次数：10843175。
QuickSort:时间：3.28；比较次数：10936357。
IntroSort:时间：3.35；比较次数：10958355。
MergeSort:时间：4.20；比较次数：13502620。
正序分布，500000个元素：
Sort:时间：1.71；比较次数：8401712。
QuickSort:时间：1.91；比较次数：9262161。
IntroSort:时间：1.80；比较次数：8401712。
MergeSort:时间：1.72；比较次数：4766525。
逆序分布，500000个元素：
Sort:时间：2.38；比较次数：11737937。
QuickSort:时间：2.54；比较次数：12619014。
IntroSort:时间：2.38；比较次数：11293745。
MergeSort:时间：1.69；比较次数：4192495。
相同值，500000个元素：
Sort:时间：1.41；比较次数：8401712。
QuickSort:时间：1.47；比较次数：9262161。
IntroSort:时间：1.40；比较次数：8401712。
MergeSort:时间：1.43；比较次数：4766525。
波形分布（波长1000），500000个元素：
Sort:时间：2.52；比较次数：10658948。
QuickSort:时间：2.97；比较次数：12971845。
IntroSort:时间：3.02；比较次数：12672744。
MergeSort:时间：2.71；比较次数：7978745。
峰形分布（前半段为正序，后半段为前半段的逆转），500000个元素：
Sort:时间：2.42；比较次数：10401407。
IntroSort:时间：5.13；比较次数：19211813。
MergeSort:时间：1.88；比较次数：5176855。
谷形分布（峰形分布的逆转），500000个元素：
Sort:时间：2.29；比较次数：10944792。
IntroSort:时间：5.29；比较次数：17898801。
MergeSort:时间：1.90；比较次数：5282136。
由于这个排序的最差分布不是很好寻找，我修改了一下Partition函数，使正序分成成为它的不利分布，然后在同一台机器上测了一下：
正序分布，500000个元素：
Sort:时间：2.77；比较次数：12011738。
IntroSort:时间：4.31；比较次数：19212426。
MergeSort:时间：1.73；比较次数：4766525。
据我分析，这时排序可以分成QuickSort和MergeSort两部分，两部分花的时间相互独立，所以我把这个时间与MergeSort的时间相减，然后加上随机分布情况的MergeSort的时间（取4.20)，结果为5.24，应该是差不多的。
从这个结果来看，和IntroSort的最差情况基本上是差不多的。
在这里感谢CSDN的LeeMaRS和ZhanYv，他们在论坛上和我对排序的改进进行了很多讨论，并给了我很大帮助。LeeMaRS为我提供了一个优秀的Partition函数。
下面给出实现的完整代码：
type
TPointerList = array[0..32767] of Pointer;
PPointerList = ^TPointerList;
PPointer = ^ Pointer;
TLessThenProc = function(Left, Right: Pointer): Boolean;
const
SORT_MAX = 16;
MAX_RATIO = 8;
{**************************************************************************
函数：Partition
功能：将一个序列划分成两个子序列，后一子序列所有值都不大于前一子序列任意值。
返回子序列分割处索引。
参数：
Data: PPointerList，源序列。
Size: Integer, 序列长度。
LessThen: TLessThenProc，用于定义顺序的比较函数
说明：
用于“快速排序”
枢值策略：选择0、0.5、1三处的值的中间值
返回值保证：
A < Result 则必然 not LessThen(Data[Result], Data[A]);
A > Result 则必然 not LessThen(Data[A], Data[Result]);
**************************************************************************}
function Partition(Data: PPointerList; Size: Integer;LessThen: TLessThenProc): Integer;
var
M: Integer;
Value: Pointer;
begin
M := Size div 2;
Dec(Size);
if LessThen(Data[0], Data[M]) then
Swap(Data[M], Data[0]);
if LessThen(Data[Size], Data[0]) then
Swap(Data[Size], Data[0]);
if LessThen(Data[0], Data[M]) then
Swap(Data[M], Data[0]);
Value := Data[0];
Result := 0;
while Result < Size do
begin
while (Result < Size) and LessThen(Value, Data[Size]) do
Dec(Size);
If Result < Size then
begin
Data[Result] := Data[Size];
Inc(Result);
end;
while (Result < Size) and LessThen(Data[Result], Value) do
Inc(Result);
If Result < Size then
begin
Data[Size] := Data[Result];
Dec(Size);
end;
end;
Data[Result] := Value;
end;
{**************************************************************************
函数：Merge
功能：将两个有序序列合并为一个有序列序。
参数：
SrcFirst, SrcSecond: PPointerList，两个源序列。合并时如果有相同的值，
SrcSecond的值将排在SrcFirst的值的后面。
Dest：PPointerList，存放合并结果的序列，必须有足够的空间。
SizeFirst, SizeSecond: Integer, 两个源序列长度
LessThen: TLessThenProc，用于定义顺序的比较函数
**************************************************************************}
procedure Merge(SrcFirst, SrcSecond, Dest: PPointerList;
SizeFirst, SizeSecond: Integer; LessThen: TLessThenProc);
var
I: Integer;
IsFirst: Boolean;
begin
IsFirst := True;
if (SizeFirst = 0) or (LessThen(SrcSecond[0], SrcFirst[0])) then
begin
Swap(Pointer(SrcFirst), Pointer(SrcSecond));
Swap(SizeFirst, SizeSecond);
IsFirst := not IsFirst;
end;
while SizeFirst > 0 do
begin
if SizeSecond = 0 then
I := SizeFirst
else
begin
I := 0;
while (I < SizeFirst) and
((IsFirst and not LessThen(SrcSecond[0], SrcFirst[I]))
or (not IsFirst and LessThen(SrcFirst[I], SrcSecond[0]))) do
Inc(I);
end;
Move(SrcFirst^, Dest^, Sizeof(Pointer) * I);
Dec(SizeFirst, I);
SrcFirst := @SrcFirst[I];
Dest := @Dest[I];
Swap(Pointer(SrcFirst), Pointer(SrcSecond));
Swap(SizeFirst, SizeSecond);
IsFirst := not IsFirst;
end;
end;
{**************************************************************************
函数：SortInsert
功能：向有序序列中插入一个值，保证插入后仍然有序。
参数：
Data: PPointerList，有序序列，必须可容纳Size + 1个元素
Size: Integer, 原序列长度
Value: 新插入的值
LessThen: TLessThenProc，用于定义顺序的比较函数
**************************************************************************}
procedure SortInsert(Data: PPointerList; Size: Integer; Value: Pointer; LessThen: TLessThenProc);
var
J: Integer;
begin
if LessThen(Value, Data[0]) then
J := 0
else
begin
J := Size;
while (J > 0) and LessThen(Value, Data[J - 1]) do
Dec(J);
end;
Move(Data[J], Data[J +1], Sizeof(Pointer) * (Size - J));
Data[J] := Value;
end;
{**************************************************************************
函数：MergePart
功能：将序列中的两个邻近有序子序列合并为一个有序子序列并存放在原处。
参数：
Data: PPointerList，源序列。
PartSize: Integer, 第一个有序子序列长度。
Size: Integer, 序列总长度。
LessThen: TLessThenProc，用于定义顺序的比较函数
说明：
如果自由空间足够，调用Merge实现，否则调用SortInsert。
**************************************************************************}
procedure MergePart(Data: PPointerList; First: Integer; Size: Integer;LessThen: TLessThenProc);
var
Buffer: PPointerList;
I: Integer;
begin
Buffer := AllocMem(Size * Sizeof(Pointer));
if Buffer <> nil then
begin
Move(Data^, Buffer^, Size * Sizeof(Pointer));
Merge(@Buffer[0], @Buffer[First], Data, First, Size-First, LessThen);
FreeMem(Buffer);
end
else
begin
Dec(Size);
for I := PartSize to Size do
SortInsert(Data, I, Data[I], LessThen);
end;
end;
{**************************************************************************
函数：InsertionSort
功能：简单插入排序
参数：
Data: PPointerList，源序列。
Size: Integer, 序列长度。
LessThen: TLessThenProc，用于定义顺序的比较函数
**************************************************************************}
procedure InsertionSort(Data: PPointerList; Size: Integer;
LessThen: TLessThenProc);
var
I: Integer;
begin
Dec(Size);
for I := 1 to Size do
SortInsert(Data, I, Data[I], LessThen);
end;
{**************************************************************************
函数：Sort
功能：排序
参数：
Data: PPointerList，源序列。
Size: Integer, 序列长度。
LessThen: TLessThenProc，用于定义顺序的比较函数
说明：
使用快速排序。
当子序列长度不大于SORT_MAX时使用插入排序。
当子序列长度比大于MAX_RATIO时将长子序列一分为二分别排序，然后合并。
**************************************************************************}
procedure Sort(Data: PPointerList; Size: Integer; LessThen: TLessThenProc);
var
M: Integer;
OtherData: PPointerList;
OtherSize: Integer;
begin
Assert(Data <> nil);
while Size > SORT_MAX do
begin
M := Partition(Data, Size, LessThen);
if (M <= Size div 2) then
begin
OtherData := @Data[M + 1];
OtherSize := Size - M - 1;
Size := M;
end
else
begin
OtherData := Data;
OtherSize := M;
Data := @OtherData[M + 1];
Size := Size - M - 1;
end;
if (OtherSize div MAX_RATIO > Size) then
begin
M := OtherSize div 2;
Sort(OtherData, M, LessThen, MaxRatio);
Sort(@OtherData[M], OtherSize - M, LessThen, MaxRatio);
MergePart(OtherData, M, OtherSize, LessThen);
end
else
Sort(OtherData, OtherSize, LessThen, MaxRatio);
end;
InsertionSort(Data, Size, LessThen);
end;
