まずソートを行うためのレコード型と、ソートアルゴリズムを実装するクラスの継承元クラスの宣言です。
{$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)
0 件のコメント:
コメントを投稿