まずソートを行うためのレコード型と、ソートアルゴリズムを実装するクラスの継承元クラスの宣言です。
{$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;
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;
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;
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;
→ジェネリックスのリストをアルゴリズムを指定してソートする(Gist)
