请大家帮我分析一下这个排序

[短歌如风]

我对Quick Sort做了一些改进，主要方法是在把序列划分成两个子序列后，如果长子序列的长度超过短子序列的长度的二倍，则把长子序列平分成两个子序列分别排序然后合并。
此外就是取枢值和短序列使用插入排序。
我大致测试了一下，在“峰形”和“谷形”这两种对Quick Sort不利的分布时比Intro Sort要快。不过我想知道它的最差分布是什么，效率如何，请大家帮忙分析。

代码如下（Object Pascal)：
procedure QuickSort(Data: PPointerList; Size: Integer; LessThen: TLessThenProc);//改进的QuickSort
var
M: Integer;
OtherData: PPointerList;
OtherSize: Integer;
begin
Assert(Data <> nil);
while Size > SORT_MAX do
begin
M := BinaryPart(Data, Size, LessThen);//用Quick Sort的逻辑划分子序列。
if (M < Size div 2) then
begin
OtherData := @Data[M];
OtherSize := Size - M;
Size := M;
end
else
begin
OtherData := Data;
OtherSize := M;
Data := @OtherData[M];
Size := Size - M;
end;
　　//<Data, Size>是短子序列，<OtherData, OtherSize>是较长子序列
M := OtherSize div 2;
if (M > Size) then
begin
QuickSort(OtherData, M, LessThen);
QuickSort(@OtherData[M], OtherSize - M, LessThen);
MergePart(OtherData, M, OtherSize, LessThen);
end
else
begin
QuickSort(OtherData, OtherSize, LessThen);
end;
end;
InsertionSort(Data, Size, LessThen);
end;

下面是用到的类型、常量定义和其它函数
type
TPointerList = array[0..32767] of Pointer;
PPointerList = ^TPointerList;
PPointer = ^ Pointer;
TLessThenProc = function(Left, Right: Pointer): Boolean;
TSortProc = procedure(Data: PPointerList; Size: Integer; LessThen: TLessThenProc);
TClockProc = function(): Double;

const
SORT_MAX:Integer = 16;

procedure Swap(var Left, Right: Pointer); overload;//交换两个指针
var
Temp:Pointer;
begin
Temp := Left;
Left := Right;
Right := Temp;
end;

procedure Swap(var Left, Right: Integer); overload;//交换两个整数
var
Temp: Integer;
begin
Temp := Left;
Left := Right;
Right := Temp;
end;

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
begin
Dec(J);
end;
end;
Move(Data[J], Data[J +1], Sizeof(Pointer) * (Size - J));
Data[J] := Value;
end;

procedure SortMerge(SrcFirst, SrcSecond, Dest: PPointerList;
SizeFirst, SizeSecond: Integer; LessThen: TLessThenProc);//合并两个有序序列，目标和源无叠。
var
I: Integer;
begin
if (SizeFirst = 0) or (LessThen(SrcSecond[0], SrcFirst[0])) then
begin
Swap(Pointer(SrcFirst), Pointer(SrcSecond));
Swap(SizeFirst, SizeSecond);
end;
while SizeFirst > 0 do
begin
if SizeSecond = 0 then
I := SizeFirst
else
begin
I := 0;
while (I < SizeFirst) and not LessThen(SrcSecond[0], SrcFirst[I]) 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);
end;
end;

procedure MergePart(Data: PPointerList; PartSize: Integer; Size: Integer;
LessThen: TLessThenProc);//把Data中的两个有序子序列合并成一个，空间不足时使用插入实现
var
Buffer: array of Pointer;
I: Integer;
begin
try
SetLength(Buffer, Size);
Move(Data^, Buffer[0], Size * Sizeof(Pointer));
SortMerge(@Buffer[0], @Buffer[PartSize], Data, PartSize, Size-PartSize, LessThen);
SetLength(Buffer, 0);
except
Dec(Size);
for I := PartSize to Size do
SortInsert(Data, I, Data[I], LessThen);
end;
end;

procedure InsertionSort(Data: PPointerList; Size: Integer;
LessThen: TLessThenProc);//简单插入排序
var
I, J: Integer;
Value: Pointer;
begin
Dec(Size);
for I := 1 to Size do
begin
SortInsert(Data, I, Data[I], LessThen);
end;
end;

function BinaryPart(Data: PPointerList; Size: Integer;
LessThen: TLessThenProc): Integer;//Quick　Sort的一次迭代，划分子序列。
var
M: Integer;
Value: Pointer;
UnComplete: Boolean;
begin
M := Size shr 1;
Dec(Size);
if LessThen(Data[M], Data[0]) then
Swap(Data[0], Data[M]);
if LessThen(Data[Size], Data[M]) then
Swap(Data[Size], Data[M]);
if LessThen(Data[M], Data[0]) then
Swap(Data[0], Data[M]);
Value := Data[M];
Result := 0;
UnComplete := Size > Result;
while UnComplete do
begin
while LessThen(Data[Result], Value) do
Inc(Result);
while LessThen(Value, Data[Size]) do
Dec(Size);
UnComplete := Size > Result;
if UnComplete then
begin
Swap(Data[Result], Data[Size]);
Inc(Result);
Dec(Size);
end;
end;
end;

[plainsongshadow]

随机种子：-764078921；元素个数：10。
比较次数 RandQSort SimpleQSort
19 147840 147840
20 296448 296448
21 536832 536832
22 373536 373536
23 489312 489312
24 264768 264768
25 349600 349600
26 167264 167264
27 303360 303360
28 148288 148288
29 149440 149440
30 87808 87808
31 95104 95104
32 58560 58560
33 60096 60096
34 20416 20416
35 30208 30208
36 16128 16128
37 12928 12928
38 6528 6528
39 7040 7040
40 2176 2176
41 2560 2560
42 1024 1024
43 768 768
44 256 256
45 512 512
随机种子：28527863；元素个数：11。
比较次数 RandQSort SimpleQSort
22 844800 844800
23 2766720 2766720
24 3482688 3482688
25 5086272 5086272
26 3836416 3836416
27 4273856 4273856
28 2935104 2935104
29 2906752 2906752
30 2593408 2593408
31 2412544 2412544
32 1598272 1598272
33 1844544 1844544
34 1174656 1174656
35 972480 972480
36 648128 648128
37 791040 791040
38 414336 414336
39 387200 387200
40 246016 246016
41 211968 211968
42 142720 142720
43 130432 130432
44 48512 48512
45 62976 62976
46 37376 37376
47 25856 25856
48 13056 13056
49 14080 14080
50 4352 4352
51 5120 5120
52 2048 2048
53 1536 1536
54 512 512
55 1024 1024

[LeeMaRS]

plainsong(短歌)，由于各种算法的不同实现也会影响到效率，建议把各算法的程序再公布一下。
另外能否生成一些数据给我，我自己也测试一下看看。

[短歌如风]

我晚上想了一下，我认为这种用Merge改进的QSort的最差情况也是在每次划分都生成长度为2和N-2的两个子序列时（由于枢值取值策略，不会生成1和N-1的子序列），这时就成了递归实现的二路归并，但在每次归并时，除了合并要求的约N次比较外，还多了额外的约N次比较，作用只是提出两个元素不参与合并，所以我觉得最差情况时间复杂度应该是O(N*log(N))，比较次数大约是二路归并的二倍。不知道这样分析是否合理。根据IntroSort在最差情况效率大约是HeapSort两倍的情况来看，觉得还是比不上IntroSort。

LeeMaRS说的对，不同实现对效率是有影响的。我把代码贴在这里共大家参考：
interface

type
TPointerList = array[0..32767] of Pointer;
PPointerList = ^TPointerList;
PPointer = ^ Pointer;
TLessThenProc = function(Left, Right: Pointer): Boolean;
TSortProc = procedure(Data: PPointerList; Size: Integer; LessThen: TLessThenProc);
TClockProc = function(): Double;

procedure InsertionSort(Data: PPointerList; Size: Integer; LessThen: TLessThenProc);
procedure HeapSort(Data: PPointerList; Size: Integer; LessThen: TLessThenProc);
procedure MergeSort(Data: PPointerList; Size: Integer; LessThen: TLessThenProc);
procedure IntroSort(Data: PPointerList; Size: Integer; LessThen: TLessThenProc);
procedure QuickSort(Data: PPointerList; Size: Integer; LessThen: TLessThenProc);
Procedure RandQSort(Data: PPointerList; Size: Integer; LessThen: TLessThenProc);

function CheckSort(Data: PPointerList; Size: Integer; LessThen: TLessThenProc): Boolean;
function TestSort(Data: PPointerList; Size: Integer; LessThen: TLessThenProc;
SortProc: TSortProc; Clock: TClockProc): String;

implementation

uses
SysUtils;

const
SORT_MAX:Integer = 16;

procedure Swap(var Left, Right: Pointer); overload;
var
Temp:Pointer;
begin
Temp := Left;
Left := Right;
Right := Temp;
end;

procedure Swap(var Left, Right: Integer); overload;
var
Temp: Integer;
begin
Temp := Left;
Left := Right;
Right := Temp;
end;

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
begin
Dec(J);
end;
end;
Move(Data[J], Data[J +1], Sizeof(Pointer) * (Size - J));
Data[J] := Value;
end;

procedure SortMerge(SrcFirst, SrcSecond, Dest: PPointerList;
SizeFirst, SizeSecond: Integer; LessThen: TLessThenProc);
var
I: Integer;
begin
if (SizeFirst = 0) or (LessThen(SrcSecond[0], SrcFirst[0])) then
begin
Swap(Pointer(SrcFirst), Pointer(SrcSecond));
Swap(SizeFirst, SizeSecond);
end;
while SizeFirst > 0 do
begin
if SizeSecond = 0 then
I := SizeFirst
else
begin
I := 0;
while (I < SizeFirst) and not LessThen(SrcSecond[0], SrcFirst[I]) 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);
end;
end;

//将序列中的两个邻近有序子序列合并为一个有序子序列并存放在原处
//自由空间足够时时间复杂度为O(N)，空间复杂度为O(N)，需要Size*Sizeof(Pointer)字节的自由空间
//自由空间不足时时间复杂度为O(N^2)，空间复杂度为O(1)，使用插入排序实现
procedure MergePart(Data: PPointerList; PartSize: 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));
SortMerge(@Buffer[0], @Buffer[PartSize], Data, PartSize, Size-PartSize, LessThen);
FreeMem(Buffer);
end
else
begin
Dec(Size);
for I := PartSize to Size do
SortInsert(Data, I, Data[I], LessThen);
end;
end;

//将一个序列划分成两个子序列，后一子序列所有值都不大于前一子序列任意值。返回子序列分割处索引
//用于IntroSort和QuickSort
//枢值策略：选择0、0.5、1三处的值的中间值。
function BinaryPart(Data: PPointerList; Size: Integer;
LessThen: TLessThenProc): Integer;
var
M: Integer;
Value: Pointer;
UnComplete: Boolean;
begin
M := Size shr 1;
Dec(Size);
if LessThen(Data[M], Data[0]) then
Swap(Data[0], Data[M]);
if LessThen(Data[Size], Data[M]) then
Swap(Data[Size], Data[M]);
if LessThen(Data[M], Data[0]) then
Swap(Data[0], Data[M]);
Value := Data[M];
Result := 0;
UnComplete := Size > Result;
while UnComplete do
begin
while LessThen(Data[Result], Value) do
Inc(Result);
while LessThen(Value, Data[Size]) do
Dec(Size);
UnComplete := Size > Result;
if UnComplete then
begin
Swap(Data[Result], Data[Size]);
Inc(Result);
Dec(Size);
end;
end;
end;

procedure PushHeap(Data: PPointerList; Index, Size: Integer;
Value: Pointer; LessThen: TLessThenProc);
var
I: Integer;
begin
I := (Index - 1) shr 1;
while (Size < Index) and LessThen(Data[I], Value) do
begin
Data[Index] := Data[I];
Index := I;
I := (Index - 1) shr 1;
end;
Data[Index] := Value;
end;

procedure AdjustHeap(Data: PPointerList; Index, Size: Integer; Value: Pointer;
LessThen: TLessThenProc);
var
J, K: Integer;
begin
J := Index;
K := Index shl 1 + 2;
while K < Size do
begin
if LessThen(Data[K], Data[K - 1]) then
Dec(K);
Data[Index] := Data[K];
Index := K;
K := K shl 1 + 2;
end;
if K = Size then
begin
Data[Index] := Data[K - 1];
Index := K - 1;
end;
PushHeap(Data, Index, J, Value, LessThen);
end;

procedure MakeHeap(Data: PPointerList; Size:
Integer; LessThen: TLessThenProc);
var
H: Integer;
begin
H := Size shr 1;
while H > 0 do
begin
Dec(H);
AdjustHeap(Data, H, Size, Data[H], LessThen);
end;
end;

procedure PopHeap(Data: PPointerList; Size, Index: Integer;
Value: Pointer; LessThen: TLessThenProc);
begin
Data[Index] := Data[0];
AdjustHeap(Data, 0, Size, Value, LessThen);
end;

//用建好的堆进行排序，子序列长度不大于SORT_MAX时使用插入排序
//???用已建好的长度不大于SORT_MAX的堆进行排序时插入和堆排如何选择???
procedure SortHeap(Data: PPointerList; Size: Integer;
LessThen: TLessThenProc);
begin
while Size > SORT_MAX do
begin
Dec(Size);
PopHeap(Data, Size, Size, Data[Size], LessThen);
end;
InsertionSort(Data, Size, LessThen);
end;

[短歌如风]

继续……

//简单插入排序；稳定
//时间复杂度为O(N)（最好）、O(N^2)（平均、最差）。
//空间复杂度为O(1)
procedure InsertionSort(Data: PPointerList; Size: Integer;
LessThen: TLessThenProc);
var
I: Integer;
begin
Dec(Size);
for I := 1 to Size do
begin
SortInsert(Data, I, Data[I], LessThen);
end;
end;

//归并排序；子序列长度小于SORT_MAX时使用插入排序；不稳定
//自由空间足够时时间复杂度为O(N*Log(N))（最好、平均、最差），空间复杂度为O(N)
//自由空间不足时时间复杂度为O(N*Log(N))(最好）、O(N*Log(N)*Log(N))(平均、最差），空间复杂度为O(1)
procedure MergeSort(Data: PPointerList; Size: Integer; LessThen: TLessThenProc);
var
Ideal: Integer;
I: Integer;
BlockStart: Integer;
BlockCount: Integer;
LastBlockStart: Integer;
LastBlockSize: Integer;
ResidualSize: Integer;
begin
Ideal := SORT_MAX;
BlockCount := (Size + Ideal - 1) div Ideal;
BlockStart := 0;
Dec(BlockCount);
for I := 1 to BlockCount do
begin
InsertionSort(@Data[BlockStart], Ideal, LessThen);
Inc(BlockStart, Ideal);
end;
LastBlockStart := (BlockCount) * Ideal;
LastBlockSize := Size - LastBlockStart;
InsertionSort(@Data[LastBlockStart], LastBlockSize, LessThen);
ResidualSize := LastBlockSize;
Dec(Size, LastBlockSize);

while BlockCount > 1 do
begin
if BlockCount mod 2 > 0 then
begin
LastBlockStart := (BlockCount - 1) * Ideal;
LastBlockSize := Size - LastBlockStart;
Inc(ResidualSize, LastBlockSize);
Dec(Size, LastBlockSize);
MergePart(@Data[LastBlockStart], LastBlockSize, ResidualSize, LessThen);
end;

BlockCount := BlockCount div 2;
BlockStart := 0;
for I := 1 to BlockCount do
begin
MergePart(@Data[BlockStart], Ideal, Ideal * 2, LessThen);
Inc(BlockStart, Ideal * 2);
end;
Ideal := Ideal * 2;
end;

MergePart(Data, Size, Size + ResidualSize, LessThen);
end;

//堆排序；调用用SortHeap实现；不稳定
//时间复杂度为O(N*Log(N))（最好、平均、最差）
//空间复杂度为O（1)
procedure HeapSort(Data: PPointerList; Size: Integer; LessThen: TLessThenProc);
begin
if Size >= 2 then
MakeHeap(Data, Size, LessThen);
SortHeap(Data, Size, LessThen);
end;

//改进的快速排序；不稳定
//当划分的两个子序列长度比大于2:1或小于1:2时，将较长的子序列平分为两个子序列并分别排序，然后合并。
//最大递归深度为Log(2,N)
//自由空间足够时时间复杂度为O(N*Log(N))，空间复杂度为O(Log(N))（最好）,O（N）（最差），O(??)（平均）
//自由空间不足时时间复杂度为O(N*Log(N))（最好），O(N*Log(N)*Log(N))（最差），O(??)（平均），空间复杂度为O(Log(N))
procedure QuickSort(Data: PPointerList; Size: Integer; LessThen: TLessThenProc);
var
M: Integer;
OtherData: PPointerList;
OtherSize: Integer;
begin
Assert(Data <> nil);
while Size > SORT_MAX do
begin
M := BinaryPart(Data, Size, LessThen);
if (M < Size div 2) then
begin
OtherData := @Data[M];
OtherSize := Size - M;
Size := M;
end
else
begin
OtherData := Data;
OtherSize := M;
Data := @OtherData[M];
Size := Size - M;
end;

M := OtherSize div 2;
if (M > Size) then
begin
QuickSort(OtherData, M, LessThen);
QuickSort(@OtherData[M], OtherSize - M, LessThen);
MergePart(OtherData, M, OtherSize, LessThen);
end
else
begin
QuickSort(OtherData, OtherSize, LessThen);
end;
end;
InsertionSort(Data, Size, LessThen);
end;

//对QuickSort的有效改进方法；不稳定
//当递归深度达到Log(2,N)仍为完成排序时改用堆排序。
//时间复杂度为O(N*Log(N))
//空间复杂度为O(Log(N))
//最大递归深度为Log(2,N)
procedure IntroSort(Data: PPointerList; Size: Integer; LessThen: TLessThenProc);

procedure OtherSort(Data: PPointerList; Size: Integer;
LessThen: TLessThenProc);
begin
HeapSort(Data, Size, LessThen);
end;

procedure InternalSort(Data: PPointerList; Size: Integer;
Ideal: Integer; LessThen: TLessThenProc);
type
TSortData = record
Data: PPointerList;
Size: Integer;
Ideal: Integer;
end;
var
M: Integer;
SortStack: array [0..Sizeof(Integer) * 8] of TSortData;
StackTop: Integer;
begin
StackTop := 0;
repeat
Assert(Data <> nil);
while Size > SORT_MAX do
begin
if Ideal = 0 then
begin
OtherSort(Data, Size, LessThen);
Size := 0;
end
else
begin
M := BinaryPart(Data, Size, LessThen);
Ideal := Ideal shr 1;
Inc(StackTop);
SortStack[StackTop].Data := Data;
SortStack[StackTop].Size := M;
SortStack[StackTop].Ideal := Ideal;
Data := PPointerList(@Data[M]);
Size := Size - M;
end;
end;
InsertionSort(Data, Size, LessThen);
Data := SortStack[StackTop].Data;
Size := SortStack[StackTop].Size;
Ideal := SortStack[StackTop].Ideal;
Dec(StackTop);
until StackTop < 0;
end;

begin
InternalSort(Data, Size, Size, LessThen);
end;

//使用随机位置枢值的QSort，根据LeeMaRS代码修改完成；不稳定
//对较长子序列使用循环而对短序列使用递归（一次递归的QSort算法）
//最大递归深度为Log(2,N)
//时间复杂度为O(N*Log(N))（最好，平均），O(N^2)（最差）
//空间复杂度为O(Log(N))
Procedure RandQSort(Data: PPointerList; Size: Integer; LessThen: TLessThenProc);
Var
i, j, q, t : LongInt;
x : Pointer;
Begin
While (Size > 1) Do
Begin
t := Random(Size);
x := Data[t];
Data[t] := Data[0];
Data[0] := x;

i := 0; j := Size - 1;
While (i < j) Do
Begin
While (i < j) AND (LessThen(x, Data[j])) Do
Dec(j);
If (i < j) Then
Begin
Data[i] := Data[j];
Inc(i);
End;
While (i < j) AND (LessThen(Data[i], x)) Do
Inc(i);
If (i < j) Then
Begin
Data[j] := Data[i];
Dec(j);
End;
End;
q := i; Data[i] := x;

If (Size - q - 1 > q) Then
Begin
RandQSort(Data, q, LessThen);
Data := @Data[q + 1];
Size := Size - q - 1;
End
Else
Begin
RandQSort(@Data[q + 1], Size - q - 1, LessThen);
Size := q;
End;
End;
End;

[短歌如风]

//以下是测试用代码


function CheckSort(Data: PPointerList; Size: Integer; LessThen: TLessThenProc): Boolean;
var
I: Integer;
begin
I := 1;
while (I < Size) and not LessThen(Data[I], Data[I-1]) do
Inc(I);
Result := I = Size;
end;

var
CompareCount: Integer;
CompareProc: TLessThenProc;

function TestLessThen(Left, Right: Pointer): Boolean;
begin
Inc(CompareCount);
Result := CompareProc(Left, Right);
end;

function TestSort(Data: PPointerList; Size: Integer; LessThen: TLessThenProc;
SortProc: TSortProc; Clock: TClockProc): String;
var
SortedData: array of Pointer;
ClockValue: Double;
begin
CompareCount := 0;
CompareProc := LessThen;
SetLength(SortedData, Size);
Move(Data^, SortedData[0], Size * Sizeof(Pointer));
ClockValue := Clock;
SortProc(@SortedData[0], Size, TestLessThen);
ClockValue := Clock - ClockValue;
if not CheckSort(@SortedData[0], Size, LessThen) then
Result := 'Error'
else
Result := Format('时间：%f；比较次数：%d', [ClockValue, CompareCount]);
end;

测试单元部分代码：
uses
SortUtils, StrUtils;

function Clock: Double;
begin
Result := GetTickCount / 1000;
end;
{$R *.dfm}

function StrLessThen(Left, Right: PString): Boolean;
begin
Result := CompareText(Left^, Right^) < 0;
end;

function TestSortProcs(Data: PPointerList; Size: Integer; LessThen: TLessThenProc): String;
begin
Result := Format(
'QuickSort:%s'^M^j +
'MergeSort:%s'^M^j +
'IntroSort:%s'^M^J +
'HeapSort: %s'^M^J +
'RandQSort:%s',
[TestSort(Data, Size, LessThen, QuickSort, Clock),
TestSort(Data, Size, LessThen, MergeSort, Clock),
TestSort(Data, Size, LessThen, IntroSort, Clock),
TestSort(Data, Size, LessThen, HeapSort, Clock),
TestSort(Data, Size, LessThen, RandQSort, Clock)]);
end;

//随机分布：
procedure TForm1.TestRandClick(Sender: TObject);
var
Data: array of String;
PtrData: array of PString;
DataSize: Integer;
I: Integer;
begin
DataSize := iptDataSize.Value;
SetLength(Data, DataSize);
SetLength(PtrData, DataSize);
for I := 0 to DataSize - 1 do
begin
Data[I] := RightStr('0000000000' + IntToStr(Random($7ffffffff)), 10);//不同分布情况关键在于这句。
PtrData[I] := @Data[I];
end;

MemoResult.Lines.Add(Format('随机分布，%d个元素：', [DataSize]));
MemoResult.Lines.Add(TestSortProcs(@PtrData[0], DataSize, @StrLessThen));
MemoResult.Lines.Add('');
SetLength(Data, 0);
SetLength(PtrData, 0);
end;

正序分布：
Data[I] := RightStr('0000000000' + IntToStr(I), 10);
逆序分布：
Data[I] := RightStr('0000000000' + IntToStr(DataSize - I), 10);
峰形分布：
Data[I] := RightStr('0000000000' + IntToStr(DataSize - Abs(I - DataSize div 2)), 10);
谷形分布：
Data[I] := RightStr('0000000000' + IntToStr(Abs(I - DataSize div 2)), 10);

[LeeMaRS]

突然发现连影子都上了, 先插一脚, 给plainsong(短歌)继续发言.

我总感觉plainsong(短歌)对随机化算法的分析与我实际的感受有所不符，再推荐一个国家队的论文：1999年周咏基《论随机化算法的原理与设计》。

另外，似乎应用简单快速排序与随机化的简单快速排序进行比较，拿我的程序去和用MergeSort优化后的对比好像有点不太公平的样子^^

[短歌如风]

关于随机快速排序的分析，其实是个概率问题。如果假设N元素的任一个排列出现的可能都是1/N!，则是否随机完全没有影响，我想对随机的效果的分析这所以有争论就是因为对也排列出现概率的不同观点吧。我个人认为，如果认为元素排列是不平均概率，可能基本有序和基本倒序出现的概率可能更多一，从这一点看，使用随机枢值效果并不好。

关于使用MergerSort改进QuickSort的方法，我现在是在子序列长度比为1:2时进行一次Merge，我觉得选择不同的比值对效果会有影响，我昨天用1:2、1:4和1:8试了一下，重复用Delphi的Random生成1,000,000个元素进行排序比较，运行一晚上，结果感觉1:8效果最好。不过还有对结果进行详细统计，因为我准备多增加几种不同比值重新测试，并且Delphi的随机数源也不够理想，周期不够长，我准备自己写一个多线性同余发生器的组合随机数源，然后再测试统计。

不过基于这种统计的结果总是不够全面，因为在N很大时很难把所有排列测试一遍，如果能从理论上进行分析从而得到一个结果最好不过了。

[ZhangYv]

如果认为数据是绝对随机分布，则随机快速排序效率更低。但是数据如果是病态分布，随机快排的效率要高

[ZhangYv]

顺便测试一下，如果是0.618:1的情况效果如何。

[ZhangYv]

测试一下SHELL排序的效率,O(n^1.5):
procedure Shellsort(var A: array[1..n] of float);
var
i,j,incr:integer;
begin
incr := n div 2;
while incr > 0 do
begin
for i := incr+1 to n do
begin
j := i-incr;
while j > 0 do
if A[j] > A[j+incr] then
begin
Swap(A[j],A[j+incr]);
j := j-incr;
end
else
j := 0;
end;
incr := incr div 2;
end;
end; {END of ShellSort}

[LeeMaRS]

话说回来我那个排序有不少无用交换，准备再改改...

[短歌如风]

ZhangYv的ShellSort(和我以前看到的好象不一样啊)在数据量较大时比QuickSort慢很多。我不太喜欢ShellSort，因为时间复杂度很难证明，并且步长序列不好选择。我忘了在哪本书上看到说用等比数列效果是不好的。

对排序改进时减少交换比减少比较效果要差很多，建议LeeMaRS还是应该主要从这方面去考虑。

对于使用Merge改进QuickSort时的比值确定，我对比值为(1:)2到20的整数作了个测试，用1000000个随机序列，前天晚上得到185组数据，感觉是1:6时最好，昨天晚上又得到202组，一起统计的结果又有变化，是1:10最好。我准备再多测试几次，数据多一些再统计。先把当前的统计结果贴出来：
比值 平均 最好 最差　 最好10次 最差10次 最好1/3 最差1/3
1: 2 7.48 6.58 14.62 6.64 12.91 6.74 8.73
1: 3 7.42 6.50 13.65 6.54 12.63 6.64 8.74
1: 4 7.32 6.45 13.58 6.49 12.07 6.59 8.52
1: 5 7.29 6.40 13.59 6.46 12.25 6.55 8.52
1: 6 7.25 6.40 13.69 6.44 12.45 6.53 8.46
1: 7 7.27 6.34 14.09 6.41 12.98 6.51 8.54
1: 8 7.25 6.36 13.43 6.41 12.85 6.50 8.51
1: 9 7.25 6.37 13.35 6.41 12.83 6.49 8.53
1:10 7.22 6.34 13.66 6.39 12.63 6.49 8.46
1:11 7.23 6.34 13.51 6.40 12.86 6.48 8.50
1:12 7.29 6.34 13.79 6.39 13.16 6.48 8.68
1:13 7.24 6.35 13.32 6.38 12.32 6.47 8.52
1:14 7.26 6.35 13.72 6.38 12.97 6.47 8.63
1:15 7.25 6.33 13.77 6.38 12.82 6.47 8.58
1:16 7.22 6.34 13.63 6.38 12.79 6.47 8.49
1:17 7.22 6.32 13.58 6.37 12.65 6.46 8.49
1:18 7.23 6.32 13.55 6.37 12.37 6.46 8.53
1:19 7.24 6.33 13.11 6.37 12.56 6.46 8.56
1:20 7.25 6.35 13.85 6.38 12.88 6.46 8.61
平均 7.27 6.37 13.66 6.42 12.68 6.51 8.56

其中“最好10次”是指取同一比值数据中最好的10次的时间取平均值。“最差10次”、“最好1/3”、“最差1/3”同理。
各项统计数据都在平均以上的有 1:10 1:13 1:17 1:18 1:19

[ZhangYv]

我也同意希尔排序是垃圾的说法...我也写了一个程序你给测试一下，主要是从找中位数（基准划分）入手的。下面的算法是我由线性选择算法改进而来的，我不知道效率如何，你测试看看，两部分都测测效果差多少：
program Test;
uses crt;
const
MAXSIZE = 25000;
SIZE = 100000;
var
C: array [1..MAXSIZE] of real;
procedure Create();
var
i: integer;
begin
Randomize();
for i := 1 to MAXSIZE do
C[i] := Random(SIZE);
end;

procedure InsertionSort(s,e: integer);
var
i,j: integer;
x: real;
begin
for i := s+1 to e do
begin
x := C[i];
j := i-1;
while (j >= s) and (C[j] > x) do
begin
C[j+1] := C[j];
dec(j);
end;
C[j+1] := x;
end;
end;

function Partition(p,r: integer; x: real):integer;
var
i,j: integer;
t: real;
begin
i := p-1;
j := r+1;
while true do
begin
repeat j := j-1 until C[j] <= x;
repeat i := i+1 until C[i] >= x;
if (i < j) then
begin
t := C[j];
C[j] := C[i];
C[i] := t;
end
else
begin
Partition := j;
break;
end;
end;
end;

function GetPivot(var a: integer): integer;
begin
if (C[a] >= C[a+1]) then
if (C[a] <= C[a+2]) then
GetPivot := a
else if (C[a+2] <= C[a+1]) then
GetPivot := a+2
else
GetPivot := a+1
else if (C[a] >= C[a+2]) then
GetPivot := a
else if (C[a+2] <= C[a+1]) then
GetPivot := a+2
else
GetPivot := a+1;
end;

function Select_2rd(i,j,k:integer): real;
var
p, m, a: integer;
pivot,t: real;
begin
if (j-i) < 75 then
begin
InsertionSort(i,j);
Select_2rd := C[i+k-1];
end
else
begin
//procedure
for m := 0 to ((j-i-4) div 5)-1 do
begin
a := i+5*m;
p := GetPivot(a); //GetPivot
t := C[p];
C[p] := C[i+m];
C[i+m] := t;
end;
m := ((j-i-4) div 5);
a := i+5*m;
InsertionSort(a,j);
t := C[a + ((j-i-4) mod 5)];
C[a + (j-i-4) mod 5] := C[i+m];
C[i+m] := t;
{-----------------------------------------------------------------}
pivot := Select_2rd(i,i+(j-i-4) div 5, (j-i-4) div 10);

m := Partition(i,j,pivot);
p := m-i+1;
Select_2rd(i,m,k);
Select_2rd(m+1,j,k-p);
end;
end;

function Select(i,j,k:integer): real;
var
p, m, a: integer;
pivot,t: real;
begin
if (j-i) < 75 then
begin
InsertionSort(i,j);
Select := C[i+k-1];
end
else
begin
for m := 0 to ((j-i-4) div 5)-1 do
begin
a := i+5*m;
InsertionSort(a,a+4); //GetPivot
t := C[a+2];
C[a+2] := C[i+m];
C[i+m] := t;
end;
m := ((j-i-4) div 5);
a := i+5*m;
InsertionSort(a,j);
t := C[a + ((j-i-4) mod 5)];
C[a + (j-i-4) mod 5] := C[i+m];
C[i+m] := t;
{-----------------------------------------------------------------}
pivot := Select(i,i+(j-i-4) div 5, (j-i-4) div 10);

m := Partition(i,j,pivot);
p := m-i+1;
Select(i,m,k);
Select(m+1,j,k-p);
end;
end;

procedure Print();
var
i: integer;
begin
for i := 1 to MAXSIZE do
writeln(C[i]:3:3);
end;

begin
clrscr;
Create();
Select(1, MAXSIZE,(1+MAXSIZE) div 2);
// Select_2rd(1, MAXSIZE,(1+MAXSIZE) div 2);
// Print();
end.

[ZhangYv]

上面的程序分析算法复杂度太复杂了，555555555555
但是应该不会比普通的快排差.

[短歌如风]

ZhangYv的代码太复杂了。我放到D6中编译运行，结果栈溢出了。能不能简单说一下算法思想？

LeeMaRS的Partition方法很不错，能保证最后返回的位置就是枢值位置，这样就可以把序列分成[0,M-1]、[M,M]和[M+1,Size)三部分。我改了一下取枢值策略，代码放在这里供大家参考：
function Partition(Data: PPointerList; Size: Integer;
LessThen: TLessThenProc): Integer;
var
M: Integer;
Value: Pointer;
begin
M := Size shr 1;
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;

此外我也写了一个，同样保证返回位置元素是枢值，比较次数比LeeMaRS的少，不过赋值次数多，因为是用交换实现的：
function BinaryPart(Data: PPointerList; Size: Integer;
LessThen: TLessThenProc): Integer;
var
M: Integer;
begin
M := Size shr 1;
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]);

Result := 1;
while Result < Size do
begin
while (Result < Size) and LessThen(Data[0], Data[Size]) do
Dec(Size);
while (Result < Size) and LessThen(Data[Result], Data[0]) do
Inc(Result);
If Result < Size then
begin
Swap(Data[Size], Data[Result]);
Dec(Size);
Inc(Result);
end;
end;
Result := Size;
Swap(Data[0], Data[Result]);
end;

此外，如果不怕复杂的话，把开始的三个比较和交换改成：
if LessThen(Data[0], Data[M]) then //Data[0] < Data[M]
begin
if LessThen(Data[M], Data[Size]) then //Data[0] < Data[M] < Data[Size]
Swap(Data[M], Data[0])//枢值取Data[M]
else if LessThen(Data[0], Data[Size]) then//Data[0] < Data[Size] <= Data[M]
Swap(Data[0], Data[Size])//枢值取[Size]
//else枢值取Data[0]，这时Data[Size] <= Data[0] < Data[M]
end
else if LessThen(Data[Size], Data[M]) then //Data[Size] < Data[M] <= Data[0]
Swap(Data[M], Data[0])//枢值取Data[M]
else if LessThen(Data[Size], Data[0]) then//Data[M] <= Data[Size] < Data[0],
Swap(Data[0], Data[Size]);//枢值取Data[Size]
//else 枢值取Data[0]，这时Data[M] <= Data[0] <= Data[Size]

比较次数会更少。

[ZhangYv]

不会吧,太夸张了点,数据量先放小点看看效果就好.我的做法是先找数组的中位数,然后根据中位数来Partition

[pxwzd123]

顶

[LeeMaRS]

对了，说到这个“比较”和“交换”的问题，你测试过么，是swap快还是用我原来那种空位赋值的快？

[短歌如风]

用500,000随机数据测了一下，没多大区别。两个有时这个快，有时那个快，差别不超过0.05秒（每次排序要用3秒多）

[短歌如风]

我把总结写这篇文章里了：
http://www.csdn.net/Develop/article/21/21786.shtm
并且把Merge算法改了一下，这样MergeSort就是稳定的了。