Delphi 2009で導入された
ジェネリックスの
コンテナの一つである
TList<T>には
Sortメソッドがあり、比較関数としてデフォルト以外の
Comparer(コンペアラ)も渡すことができるのですが、ソートアルゴリズムそのものは
クイックソートしかありません。一般的には平均して性能が出るとされるクイックソートですが、安定ではないこと、苦手な状況が存在することなど、決して万能というわけではありません。ところがTList<T>.Sortは内部で保持している
TArray.Sortにソートを丸投げしており、ソートアルゴリズムを変更することができません。そこでアルゴリズムを指定してTList<T>(および
TObjectList<T: class>)をソートする方法を考えてみました。ただしDelphi 2009のTList<T>には
Exchangeメソッドも
Moveメソッドも存在していないため、Delphi 2010以降の対応になります。
まずソートを行うためのレコード型と、ソートアルゴリズムを実装するクラスの継承元クラスの宣言です。
{$IF RTLVersion <= 20.00}
{$MESSAGE ERROR 'Need Delphi 2010 or later'}
{$IFEND}
uses
{$IF RTLVersion >= 23.00}
System.Rtti, System.Generics.Defaults, System.Generics.Collections;
{$ELSE}
Rtti, Generics.Defaults, Generics.Collections;
{$IFEND}
type
{ Forward declarations }
TSortAlgorithm<T> = class;
{ TGenericListSorter }
TGenericListSorter = record
private
class function GetComparer<T>(List: TList<T>; const AComparer: IComparer<T>): IComparer<T>; static;
public
class procedure Sort<T: record>(List: TList<T>; Algorithm: TSortAlgorithm<T>;
const AComparer: IComparer<T>{$IF CompilerVersion >= 24.00} = nil{$IFEND}); overload; static;
{$IF CompilerVersion < 24.00}
class procedure Sort<T: record>(List: TList<T>; Algorithm: TSortAlgorithm<T>); overload; static;
{$IFEND}
class procedure Sort<T: class>(List: TObjectList<T>; Algorithm: TSortAlgorithm<T>;
const AComparer: IComparer<T>{$IF CompilerVersion >= 24.00} = nil{$IFEND}); overload; static;
{$IF CompilerVersion < 24.00}
class procedure Sort<T: class>(List: TObjectList<T>; Algorithm: TSortAlgorithm<T>); overload; static;
{$IFEND}
class procedure Sort(List: TList<String>; Algorithm: TSortAlgorithm<String>;
const AComparer: IComparer<String>{$IF CompilerVersion >= 24.00} = nil{$IFEND}); overload; static;
{$IF CompilerVersion < 24.00}
class procedure Sort(List: TList<String>; Algorithm: TSortAlgorithm<String>); overload; static;
{$IFEND}
end;
{ TSortAlgorithm (abstract) }
TSortAlgorithm<T> = class(TObject)
public
class function Instance: TSortAlgorithm<T>; virtual; abstract;
class procedure Sort(List: TList<T>; const AComparer: IComparer<T>); virtual; abstract;
end;
TGenericListSorterはソートを行うためのレコード型で、overloadされたpublicな3つ(XE2およびそれ以前は6つ、後述)のSortメソッドと、比較を行うコンペアラを決定するためのprivateなGetComparerメソッドを持ちます。Sortメソッドの1つめは値型用(
レコード制約)、2つめはクラス型用(
クラス制約)、3つめはこのどちらにも含まれない文字列型用です。IComparer<T>に
デフォルトパラメータを指定できるのはDelphi XE3以降のため、それ以前のバージョンではコンペアラを指定しないオーバロードをさらに3つ用意しました。またTSortAlgorithm<T>はソートアルゴリズムを実装するためのクラスの継承元になります。実際にソートを行うSortメソッドと、シングルトンなインスタンスを取得するためのInstanceメソッドを持ちます。TGenericListSorterの実装は次のようになります。
class procedure TGenericListSorter.Sort<T>(List: TList<T>; Algorithm: TSortAlgorithm<T>;
const AComparer: IComparer<T>);
var
Comparer: IComparer<T>;
begin
if (List = nil) or (List.Count <= 1) then
begin
Exit;
end;
Comparer := GetComparer<T>(List,AComparer);
Algorithm.Sort(List,Comparer);
end;
{$IF CompilerVersion < 24.00}
class procedure TGenericListSorter.Sort<T>(List: TList<T>; Algorithm: TSortAlgorithm<T>);
var
Comparer: IComparer<T>;
begin
if (List = nil) or (List.Count <= 1) then
begin
Exit;
end;
Comparer := GetComparer<T>(List,nil);
Algorithm.Sort(List,Comparer);
end;
{$IFEND}
class procedure TGenericListSorter.Sort<T>(List: TObjectList<T>; Algorithm: TSortAlgorithm<T>;
const AComparer: IComparer<T>);
var
Comparer: IComparer<T>;
OwnsObjects: Boolean;
begin
if (List = nil) or (List.Count <= 1) then
begin
Exit;
end;
Comparer := GetComparer<T>(List,AComparer);
OwnsObjects := List.OwnsObjects;
try
List.OwnsObjects := False;
Algorithm.Sort(List,Comparer);
finally
List.OwnsObjects := OwnsObjects;
end;
end;
{$IF CompilerVersion < 24.00}
class procedure TGenericListSorter.Sort<T>(List: TObjectList<T>; Algorithm: TSortAlgorithm<T>);
var
Comparer: IComparer<T>;
OwnsObjects: Boolean;
begin
if (List = nil) or (List.Count <= 1) then
begin
Exit;
end;
Comparer := GetComparer<T>(List,nil);
OwnsObjects := List.OwnsObjects;
try
List.OwnsObjects := False;
Algorithm.Sort(List,Comparer);
finally
List.OwnsObjects := OwnsObjects;
end;
end;
{$IFEND}
class procedure TGenericListSorter.Sort(List: TList<String>; Algorithm: TSortAlgorithm<String>;
const AComparer: IComparer<String>);
var
Comparer: IComparer<String>;
begin
if (List = nil) or (List.Count <= 1) then
begin
Exit;
end;
Comparer := GetComparer<String>(List,AComparer);
Algorithm.Sort(List,Comparer);
end;
{$IF CompilerVersion < 24.00}
class procedure TGenericListSorter.Sort(List: TList<String>; Algorithm: TSortAlgorithm<String>);
var
Comparer: IComparer<String>;
begin
if (List = nil) or (List.Count <= 1) then
begin
Exit;
end;
Comparer := GetComparer<String>(List,nil);
Algorithm.Sort(List,Comparer);
end;
{$IFEND}
class function TGenericListSorter.GetComparer<T>(List: TList<T>; const AComparer: IComparer<T>): IComparer<T>;
var
ctx: TRttiContext;
begin
Result := AComparer;
if Result = nil then
begin
Result := ctx.GetType(List.ClassType).GetField('FComparer').GetValue(List).AsType<IComparer<T>>;
end;
end;
Sortメソッドはいずれもコンペアラを確定し、指定されたソートアルゴリズムのインスタンスのSortメソッドを呼び出しています。ただしTObjectList<T>用のオーバロードはソートを行っている間、一時的にOwnsObjectsをFalseに変更しています。これはOwnsObjectsがTrueだと(以下の例のマージソートのように)Items[]に代入を行ったときに、もともと格納されているTのインスタンスを解放してしまうためで、ソートアルゴリズムのクラスで直接ソートを行うのではなく、レコード型TGenericListSorterの3つのオーバロードに処理を分けて、そこから間接的に呼び出すようになっているのはこれが理由です。またGetComparerメソッドはコンペアラが指定されていない(=nil)ときに、TList<T>の持つデフォルトのコンペアラを(
RTTIを使って)取得します。
次に実際のソートアルゴリズムを実装したクラスですが、まず
コムソートを実装してみます。
type
TCombSort<T> = class(TSortAlgorithm<T>)
protected
class var
FInstance: TSortAlgorithm<T>;
public
class destructor Destroy;
class function Instance: TSortAlgorithm<T>; override;
class procedure Sort(List: TList<T>; const AComparer: IComparer<T>); override;
end;
class destructor TCombSort<T>.Destroy;
begin
FInstance.Free;
end;
class function TCombSort<T>.Instance: TSortAlgorithm<T>;
begin
if FInstance = nil then
begin
FInstance := Self.Create;
end;
Result := FInstance;
end;
class procedure TCombSort<T>.Sort(List: TList<T>; const AComparer: IComparer<T>);
const
SHRINK_FACTOR = 1.247330950103979;
var
Index: Integer;
Gap: Integer;
Swapped: Boolean;
begin
Gap := List.Count;
Swapped := True;
while (Gap > 1) or (Swapped = True) do
begin
if Gap > 1 then
begin
Gap := Trunc(Gap / SHRINK_FACTOR);
end;
if Gap < 1 then
begin
Gap := 1;
end;
Swapped := False;
Index := 0;
while (Gap + Index) < List.Count do
begin
if AComparer.Compare(List.Items[Index],List.Items[Index + Gap]) > 0 then
begin
List.Exchange(Index,Index + Gap);
Swapped := True;
end;
Index := Index + 1;
end;
end;
end;
前述の通り(TGenericListSorterとは異なり)1種類の<T>に対してのみSortを実装すればよいようになっています。またSortメソッド以外にシングルトンなインスタンスを取得するためのInstanceメソッドと、そのインスタンスを解放するための
クラスデストラクタを用意します。これで例えばInteger型のリストに対しては
var
I: Integer;
Value: Integer;
List: TList<Integer>;
begin
List := TList<Integer>.Create;
try
for I := 0 to 999 do
begin
List.Add(Random(100000));
end;
TGenericListSorter.Sort<Integer>(List,TCombSort<Integer>.Instance,TComparer<Integer>.Construct(
function(const Left, Right: Integer): Integer
begin
Result := Left - Right;
end));
for Value in List do
begin
Memo1.Lines.Add(IntToStr(Value));
end;
finally
List.Free;
end
end;
このような形でソートを呼び出すことができます。
同じようにその他のソートアルゴリズムを実装していきます。
ノームソートです。
type
TGnomeSort<T> = class(TSortAlgorithm<T>)
protected
class var
FInstance: TSortAlgorithm<T>;
public
class destructor Destroy;
class function Instance: TSortAlgorithm<T>; override;
class procedure Sort(List: TList<T>; const AComparer: IComparer<T>); override;
end;
class destructor TGnomeSort<T>.Destroy;
begin
FInstance.Free;
end;
class function TGnomeSort<T>.Instance: TSortAlgorithm<T>;
begin
if FInstance = nil then
begin
FInstance := Self.Create;
end;
Result := FInstance;
end;
class procedure TGnomeSort<T>.Sort(List: TList<T>; const AComparer: IComparer<T>);
var
Index: Integer;
begin
Index := 0;
while Index < List.Count do
begin
if (Index = 0) or (AComparer.Compare(List.Items[Index],List.Items[Index - 1]) >= 0) then
begin
Index := Index + 1;
end
else
begin
List.Exchange(Index,Index - 1);
Index := Index - 1;
end;
end;
end;
選択ソートです。
type
TSelectionSort<T> = class(TSortAlgorithm<T>)
protected
class var
FInstance: TSortAlgorithm<T>;
public
class destructor Destroy;
class function Instance: TSortAlgorithm<T>; override;
class procedure Sort(List: TList<T>; const AComparer: IComparer<T>); override;
end;
class destructor TSelectionSort<T>.Destroy;
begin
FInstance.Free;
end;
class function TSelectionSort<T>.Instance: TSortAlgorithm<T>;
begin
if FInstance = nil then
begin
FInstance := Self.Create;
end;
Result := FInstance;
end;
class procedure TSelectionSort<T>.Sort(List: TList<T>; const AComparer: IComparer<T>);
var
Index1: Integer;
Index2: Integer;
MinIndex: Integer;
Temp: T;
begin
for Index1 := 0 to List.Count - 2 do
begin
MinIndex := Index1;
Temp := List.Items[MinIndex];
for Index2 := Index1 + 1 to List.Count - 1 do
begin
if AComparer.Compare(List.Items[Index2],Temp) < 0 then
begin
MinIndex := Index2;
Temp := List.Items[MinIndex];
end;
end;
if MinIndex <> Index1 then
begin
List.Move(MinIndex,Index1);
end;
end;
end;
挿入ソートです。
type
TInsertionSort<T> = class(TSortAlgorithm<T>)
protected
class var
FInstance: TSortAlgorithm<T>;
public
class destructor Destroy;
class function Instance: TSortAlgorithm<T>; override;
class procedure Sort(List: TList<T>; const AComparer: IComparer<T>); override;
end;
class destructor TInsertionSort<T>.Destroy;
begin
FInstance.Free;
end;
class function TInsertionSort<T>.Instance: TSortAlgorithm<T>;
begin
if FInstance = nil then
begin
FInstance := Self.Create;
end;
Result := FInstance;
end;
class procedure TInsertionSort<T>.Sort(List: TList<T>; const AComparer: IComparer<T>);
var
Comparer: IComparer<T>;
Index1: Integer;
Index2: Integer;
Temp: T;
begin
for Index1 := 1 to List.Count - 1 do
begin
Temp := List.Items[Index1];
Index2 := Index1 - 1;
while (Index2 >= 0) and (AComparer.Compare(List.Items[Index2],Temp) > 0) do
begin
Index2 := Index2 - 1;
end;
List.Move(Index1,Index2 + 1);
end;
end;
クイックソートです。
type
TQuickSort<T> = class(TSortAlgorithm<T>)
protected
class var
FInstance: TSortAlgorithm<T>;
class procedure InternalSort(List: TList<T>; Left: Integer; Right: Integer;
const AComparer: IComparer<T>);
class function Partition(List: TList<T>; Left: Integer; Right: Integer;
const AComparer: IComparer<T>): Integer;
public
class destructor Destroy;
class function Instance: TSortAlgorithm<T>; override;
class procedure Sort(List: TList<T>; const AComparer: IComparer<T>); override;
end;
class destructor TQuickSort<T>.Destroy;
begin
FInstance.Free;
end;
class function TQuickSort<T>.Instance: TSortAlgorithm<T>;
begin
if FInstance = nil then
begin
FInstance := Self.Create;
end;
Result := FInstance;
end;
class procedure TQuickSort<T>.Sort(List: TList<T>; const AComparer: IComparer<T>);
var
Comparer: IComparer<T>;
begin
InternalSort(List,0,List.Count - 1,AComparer);
end;
class procedure TQuickSort<T>.InternalSort(List: TList<T>; Left: Integer; Right: Integer;
const AComparer: IComparer<T>);
var
Pivot: Integer;
begin
if Left < Right then
begin
Pivot := Partition(List,Left,Right,AComparer);
InternalSort(List,Left, Pivot,AComparer);
InternalSort(List,Pivot + 1,Right,AComparer);
end;
end;
class function TQuickSort<T>.Partition(List: TList<T>; Left: Integer; Right: Integer;
const AComparer: IComparer<T>): Integer;
var
Index1: Integer;
Index2: Integer;
Pivot: T;
begin
Pivot := List.Items[(Left + Right) div 2];
Index1 := Left - 1;
Index2 := Right + 1;
while True do
begin
repeat
Index1 := Index1 + 1;
until (AComparer.Compare(List.Items[Index1],Pivot) >= 0);
repeat
Index2 := Index2 - 1;
until (AComparer.Compare(List.Items[Index2],Pivot) <= 0);
if Index1 >= Index2 then
begin
Result := Index2;
Exit;
end;
List.Exchange(Index1,Index2);
end;
end;
ヒープソートです。
type
THeapSort<T> = class(TSortAlgorithm<T>)
protected
class var
FInstance: TSortAlgorithm<T>;
class procedure BuildHeap(List: TList<T>; const AComparer: IComparer<T>);
class procedure Heapify(List: TList<T>; Index: Integer; Max: Integer;
const AComparer: IComparer<T>);
public
class destructor Destroy;
class function Instance: TSortAlgorithm<T>; override;
class procedure Sort(List: TList<T>; const AComparer: IComparer<T>); override;
end;
class destructor THeapSort<T>.Destroy;
begin
FInstance.Free;
end;
class function THeapSort<T>.Instance: TSortAlgorithm<T>;
begin
if FInstance = nil then
begin
FInstance := Self.Create;
end;
Result := FInstance;
end;
class procedure THeapSort<T>.Sort(List: TList<T>; const AComparer: IComparer<T>);
var
Index: Integer;
begin
BuildHeap(List,AComparer);
for Index := List.Count - 1 downto 1 do
begin
List.Exchange(0,Index);
Heapify(List,0,Index,AComparer);
end;
end;
class procedure THeapSort<T>.BuildHeap(List: TList<T>; const AComparer: IComparer<T>);
var
Index: Integer;
begin
for Index := (List.Count div 2) - 1 downto 0 do
begin
Heapify(List,Index,List.Count,AComparer);
end;
end;
class procedure THeapSort<T>.Heapify(List: TList<T>; Index: Integer; Max: Integer;
const AComparer: IComparer<T>);
var
Left: Integer;
Right: Integer;
Largest: Integer;
begin
Left := Index * 2 + 1;
Right := Index * 2 + 2;
if (Left < Max) and (AComparer.Compare(List.Items[Left],List.Items[Index]) > 0) then
begin
Largest := Left;
end
else
begin
Largest := Index;
end;
if (Right < Max) and (AComparer.Compare(List.Items[Right],List.Items[Largest]) > 0) then
begin
Largest := Right;
end;
if Largest <> Index then
begin
List.Exchange(Index,Largest);
Heapify(List,Largest,Max,AComparer);
end;
end;
マージソートです。
type
TMergeSort<T> = class(TSortAlgorithm<T>)
protected
class var
FInstance: TSortAlgorithm<T>;
class procedure InternalSort(List: TList<T>; var Work: array of T;
Left: Integer; Right: Integer;
const AComparer: IComparer<T>);
public
class destructor Destroy;
class function Instance: TSortAlgorithm<T>; override;
class procedure Sort(List: TList<T>; const AComparer: IComparer<T>); override;
end;
class destructor TMergeSort<T>.Destroy;
begin
FInstance.Free;
end;
class function TMergeSort<T>.Instance: TSortAlgorithm<T>;
begin
if FInstance = nil then
begin
FInstance := Self.Create;
end;
Result := FInstance;
end;
class procedure TMergeSort<T>.Sort(List: TList<T>; const AComparer: IComparer<T>);
var
WorkArea: array of T;
begin
SetLength(WorkArea,List.Count);
try
InternalSort(List,WorkArea,0,List.Count - 1,AComparer);
finally
SetLength(WorkArea,0);
end;
end;
class procedure TMergeSort<T>.InternalSort(List: TList<T>; var Work: array of T;
Left: Integer; Right: Integer;
const AComparer: IComparer<T>);
var
Index1: Integer;
Index2: Integer;
Index3: Integer;
Mid: Integer;
begin
if Left >= Right then
begin
Exit;
end;
Mid := (Left + Right) div 2;
InternalSort(List,Work,Left, Mid, AComparer);
InternalSort(List,Work,Mid + 1,Right,AComparer);
for Index1 := Left to Mid do
begin
Work[Index1] := List.Items[Index1];
end;
Index2 := Right;
for Index1 := Mid + 1 to Right do
begin
Work[Index1] := List.Items[Index2];
Index2 := Index2 - 1;
end;
Index1 := Left;
Index2 := Right;
for Index3 := Left to Right do
begin
if AComparer.Compare(Work[Index1],Work[Index2]) > 0 then
begin
List.Items[Index3] := Work[Index2];
Index2 := Index2 - 1;
end
else
begin
List.Items[Index3] := Work[Index1];
Index1 := Index1 + 1;
end;
end;
end;
シェルソートです。
type
TShellSort<T> = class(TSortAlgorithm<T>)
protected
class var
FInstance: TSortAlgorithm<T>;
class procedure InternalSort(List: TList<T>; Gap: Integer;
const AComparer: IComparer<T>);
public
class destructor Destroy;
class function Instance: TSortAlgorithm<T>; override;
class procedure Sort(List: TList<T>; const AComparer: IComparer<T>); override;
end;
class destructor TShellSort<T>.Destroy;
begin
FInstance.Free;
end;
class function TShellSort<T>.Instance: TSortAlgorithm<T>;
begin
if FInstance = nil then
begin
FInstance := Self.Create;
end;
Result := FInstance;
end;
class procedure TShellSort<T>.Sort(List: TList<T>; const AComparer: IComparer<T>);
var
Gap: Integer;
begin
Gap := List.Count div 2;
while Gap > 0 do
begin
InternalSort(List,Gap,AComparer);
Gap := Gap div 2;
end;
end;
class procedure TShellSort<T>.InternalSort(List: TList<T>; Gap: Integer;
const AComparer: IComparer<T>);
var
Index1: Integer;
Index2: Integer;
begin
for Index1 := Gap to List.Count - 1 do
begin
Index2 := Index1 - Gap;
while Index2 >= 0 do
begin
if AComparer.Compare(List.Items[Index2 + Gap],List.Items[Index2]) > 0 then
begin
Break;
end;
List.Exchange(Index2,Index2 + Gap);
Index2 := Index2 - Gap;
end;
end;
end;
Instanceメソッドとクラスデストラクタを毎回書かなければならないことを除けば、ソートのコードを1つ書くだけで値型に対するTList<T>(TList<String>を含む)、クラスに対するTObjectList<T>のどちらであってもソートを行うことができます。
→
ジェネリックスのリストをアルゴリズムを指定してソートする(Gist)
