Delphi 6 ローテクTips/高速マージソート

高速なマージソートの研究。
と言ってもTStringListでの話なんですが。
基本的なソートアルゴリズムの探求という類の話ではありません。

参考サイト

始めに

TStringListのSortメソッドやCustomSortメソッドはクイックソートでの実装となっています。
クイックソートは数あるソートアルゴリズムの中で実用上もっとも速いと言われますが、ことTStringListに関してはそうとも言い切れません。
というのもTStringListに実装されているクイックソートは要素の比較回数がマージソートの約1.5～2倍に及ぶため、比較の処理が重い場合マージソートの方が速くなります。
ソートアルゴリズムの説明にあるような単純な数値での比較であれば確実にクイックソートの方が速いのですが、AnsiCompareStrやAnsiCompareTextなどを使った文字列の比較になると、比較の処理に費やす時間が大きくなるのでクイックソートの速度の優位性は薄らぎます。
ちなみに、10000行のリストだと比較の回数はクイックソートで175,000回程度、マージソートで120,000回程度でした。

またクイックソートは安定ソートではありませんがマージソートは安定ソートです。
表形式のデータのソートでは安定ソートである方が便利であることが多いので、マージソートの有用性は高まります。

ということでTStringList用のマージソートを試行錯誤してみました。

普通のマージソート

procedure MergeSort1(List: TStringList; SortFunc: TStringListSortCompare);
//普通のマージソート
procedure mgSort(List: TStringList; iStart, iCount: Integer; SortFunc: TStringListSortCompare);
//iStartはソートを開始するインデックス行。
//iCountはソートする要素の数。
var
i, k: Integer;
li_Start1, li_Start2, li_Count1, li_Count2: Integer;
lsl_Buff: TStringList;
begin
if (iCount <= 1) then Exit;

li_Count1 := iCount div 2; //前半のリストの数
li_Count2 := iCount - li_Count1; //後半のリストの数
li_Start1 := iStart; //前半のリストの頭のインデックス
li_Start2 := iStart + li_Count1; //後半のリストの頭のインデックス

mgSort(List, li_Start1, li_Count1, SortFunc); //前半をソート
mgSort(List, li_Start2, li_Count2, SortFunc); //後半をソート

//ソートされた前半と後半をマージ
i := 0;
k := 0;
lsl_Buff := TStringList.Create;
try
lsl_Buff.Capacity := iCount+1;
while (i < li_Count1) and (k < li_Count2) do begin
if (SortFunc(List, li_Start1 + i, li_Start2 + k) > 0) then begin
lsl_Buff.AddObject(List.Strings[li_Start2 + k], List.Objects[li_Start2 + k]);
Inc(k);
end else begin
lsl_Buff.AddObject(List.Strings[li_Start1 + i], List.Objects[li_Start1 + i]);
Inc(i);
end;
end;

if (i = li_Count1) then begin
while (k < li_Count2) do begin
lsl_Buff.AddObject(List.Strings[li_Start2 + k], List.Objects[li_Start2 + k]);
Inc(k);
end
end else begin
while (i < li_Count1) do begin
lsl_Buff.AddObject(List.Strings[li_Start1 + i], List.Objects[li_Start1 + i]);
Inc(i);
end;
end;

for i := 0 to iCount -1 do begin
List.Strings[iStart + i] := lsl_Buff.Strings[i];
List.Objects[iStart + i] := lsl_Buff.Objects[i];
end;
finally
lsl_Buff.Free;
end;
end;
begin
mgSort(List, 0, List.Count, SortFunc);
end;

改良版

上のマージソートだと、再帰処理に入るたびにバッファを使って並べ替えられた要素を本リストに書き戻している部分が無駄なように思えました。
このあたりを何とか工夫して効率アップを図れないものかと思い、あれこれ試行錯誤した結果、リストのインデックスを配列にして持ち、再帰処理中での並べ替えはそっちでやり、最後にまとめて書き戻すというやり方にたどり着きました。

procedure MergeSort2(List: TStringList; SortFunc: TStringListSortCompare);
//インデックスの配列を使った速いマージソート
procedure mgSort(List: TStringList; var Index: array of Integer; SortFunc: TStringListSortCompare);
//http://www.ics.kagoshima-u.ac.jp/~fuchida/edu/algorithm/sort-algorithm/merge-sort.html
var
i, k: Integer;
li_Count, li_Count1, li_Count2: Integer;
l_Index1, l_Index2: array of Integer;
begin
li_Count := Length(Index);
if (li_Count > 1) then begin
li_Count1 := li_Count div 2;
li_Count2 := li_Count - li_Count1;
SetLength(l_Index1, li_Count1); //前半のインデックス
SetLength(l_Index2, li_Count2); //後半のインデックス
for i := 0 to li_Count1-1 do begin //前半のインデックスをコピー
l_Index1[i] := Index[i];
end;
for i := 0 to li_Count2-1 do begin //後半のインデックスをコピー
l_Index2[i] := Index[li_Count1+i];
end;

mgSort(List, l_Index1, SortFunc); //この中で順番が変わっている
mgSort(List, l_Index2, SortFunc); //この中で順番が変わっている

i := 0;
k := 0;
while (i < li_Count1) or (k < li_Count2) do begin
if (i >= li_Count1)
or ((k < li_Count2) and (SortFunc(List, l_Index1[i], l_Index2[k]) > 0)) then begin
Index[i+k] := l_Index2[k];
Inc(k);
end else begin
Index[i+k] := l_Index1[i];
Inc(i);
end;
end;
end;
end;
var
i: Integer;
l_Index: array of Integer;
lsl_List: TStringList;
begin
//インデックスの配列を準備
SetLength(l_Index, List.Count);
for i := 0 to High(l_Index) do begin
l_Index[i] := i;
end;

//この中で並べ替えられるのはリスト本体ではなくインデックスの配列(l_Index)の方
mgSort(List, l_Index, SortFunc);

//ソート済みのインデックスの配列を基にバッファへリストを書き出し、それを書き戻す
lsl_List := TStringList.Create;
try
for i := 0 to High(l_Index) do begin
//並べ替えられたインデックスを基にバッファへリストを書き出す
lsl_List.AddObject(List.Strings[l_Index[i]], List.Objects[l_Index[i]]);
end;
//バッファに書き出した整列済みのリストを書き戻す
List.Assign(lsl_List);
finally
lsl_List.Free;
end;
end;

最後にまとめてリストの書き換えを行うことで(比較の処理の重さにもよりますが)2～3割程度速度が増しています。

更に改良版

更に、バッファに書き出した整列済みのリストを本体リストに書き戻す処理を工夫してみました。

procedure MergeSort3(var List: TStringList; SortFunc: TStringListSortCompare);
//インデックスの配列を使った更にもうちょっとだけ速いマージソート
procedure mgSort(List: TStringList; var Index: array of Integer; SortFunc: TStringListSortCompare);
//http://www.ics.kagoshima-u.ac.jp/~fuchida/edu/algorithm/sort-algorithm/merge-sort.html
var
i, k: Integer;
li_Count, li_Count1, li_Count2: Integer;
l_Index1, l_Index2: array of Integer;
begin
li_Count := Length(Index);
if (li_Count > 1) then begin
li_Count1 := li_Count div 2;
li_Count2 := li_Count - li_Count1;
SetLength(l_Index1, li_Count1);    //前半のインデックス
SetLength(l_Index2, li_Count2);    //後半のインデックス
for i := 0 to li_Count1-1 do begin //前半のインデックスをコピー
l_Index1[i] := Index[i];
end;
for i := 0 to li_Count2-1 do begin //後半のインデックスをコピー
l_Index2[i] := Index[li_Count1+i];
end;

mgSort(List, l_Index1, SortFunc); //この中で順番が変わっている
mgSort(List, l_Index2, SortFunc); //この中で順番が変わっている

i := 0;
k := 0;
while (i < li_Count1) or (k < li_Count2) do begin
if (i >= li_Count1)
or ((k < li_Count2) and (SortFunc(List, l_Index1[i], l_Index2[k]) > 0)) then begin
Index[i+k] := l_Index2[k];
Inc(k);
end else begin
Index[i+k] := l_Index1[i];
Inc(i);
end;
end;
end;
end;
var
i: Integer;
l_Index: array of Integer;
lsl_List, lsl_Temp: TStringList;
begin
SetLength(l_Index, List.Count);
for i := 0 to High(l_Index) do begin
l_Index[i] := i;
end;

//この中で並べ替えられるのはリスト本体ではなくインデックスのリスト(l_Index)の方
mgSort(List, l_Index, SortFunc);

lsl_List := TStringList.Create;
try
//並べ替えられたインデックスの配列を基にバッファへリストを書き出す
for i := 0 to High(l_Index) do begin
lsl_List.AddObject(List.Strings[l_Index[i]], List.Objects[l_Index[i]]);
end;
//バッファとリストを入れ替え
lsl_Temp := List;
List    := lsl_List;
lsl_Temp.Free;
except
lsl_List.Free;
end;
end;

リストの付け替えみたいなことをやっているので何となく危なっかしい気もしますが、一応ちゃんと動いてはいます。
とはいえこういうことをやっても問題ないものなのか今ひとつ自信もないのでお勧めはしません。
速度的にはMergeSort2に比べて2.5～5%程度の速度向上はありますが、リストの数が少ないと差は出ないような感じもあります。
このあたりはPCの処理能力にもよるのかも知れませんが、Atomなネットブックで5万件程度以上からでないと差はでないようです。
つまり、わざわざ危なっかしいことをする必要もなく、MergeSort2でいいのではなかろうか、というのが結論です。

速度比較

function SortCompare(slList: TStringList; iIndex1, iIndex2: Integer): Integer;
begin
//Result := CompareStr(slList[iIndex1], slList[iIndex2]);

if (slList.CaseSensitive) then begin
Result := AnsiCompareStr (slList[iIndex1], slList[iIndex2])
end else begin
Result := AnsiCompareText(slList[iIndex1], slList[iIndex2])
end;
end;

CustomSortと比べて、速度は比較関数の処理内容によりますが、上記のような（Sortメソッドの処理内容と同じ）場合だとMergeSort1(普通のマージソート)はCustomSort（クイックソート）には及びませんが改良したMergeSort2やMergeSort3はCustomSortよりも速くなります。

コメントアウトしてあるCompareStr程度の処理内容であればCustomSortの方が速くなります。

ところで。
CustomSortに合わせるために引数の型や宣言をTStringListにしていますが、TStringsにしておいた方が汎用性があってよいのではないかと思います。
ただ比較の関数との型が合わないので、TStrings用の比較関数の宣言をします。