I use TList/TObjectList and TStringList (with associated objects) for a multitude of tasks, either as-is, or as basis for more complex structures. While the sort functionality is usually good enough, I sometimes need to do a stable sort, and both lists use quicksort.
What's the easiest way to implement stable sorting for TList and/or TStringList? Do I have to write my own sorting routine, or can it be done by using some clever trick with TStringListSortCompare/TListSortCompare?
You'll have to write your own sorting routine.
You can read the current QuickSort implementation, and write your own stable version (e.g. a Merge sort or any other stable variant).
Some tricks:
Count, you can use the fast pointer array (TList.List[]) instead of slower Items[] or GetItem(): sub-method calling and range checking slow down the execution;This question is rather old, but here goes my answer for future readers: I also needed this recently and adapted the implementation found in the book "The Tomes of Delphi Algorithms and Data Structures" by Julian Bucknall. Implementation for TList, TObjectList and descendant classes. It works with Delphi 2009 to XE7 and probably other versions as well: http://alexandrecmachado.blogspot.com.br/2015/02/merge-sort-for-delphi.html
From similar question How Can I Replace StringList.Sort with a Stable Sort in Delphi?, linked here in comment by lkessler I need to copy to here really easy trick as mentioned in question.
You can easily make quick sort behave stable just by adding initial order numbers into data to sort and adding last comparation condition in CustomSort compare function to compare this initial order numbers.
Easy, fast and smart. Costs only one extra integer (or byte, or use some reserved storage like TComponent.Tag if You sort TComponents) on each sortable item and one initialization loop over them.
TObjectToSort = class
...
Index: Integer;
end;
function MyStableSortComparer(List: TStringList; Index1, Index2: Integer): Integer;
var
o1, o2: TObjectToSort;
begin
o1 := TObjectToSort(List.Objects[Index1]);
o2 := TObjectToSort(List.Objects[Index2]);
...
if Result = 0 then
Result := o1.Index - o2.Index;
end;
for i := 0 to MyStrtingList.Count - 1 do
TObjectToSort(MyStrtingList.Objects[i]).Index := i;
MyStrtingList.CustomSort(MyStableSortComparer);
For anyone using generics here is a ready-to-use implementation of insertion and merge sort, both stable sorting algorithms.
uses Generics.Defaults, Generics.Collections;
type
TMySort = class
public
class procedure InsertionSort<T>(AArray: TArray<T>; FirstIndex, LastIndex: Integer; const AComparer: IComparer<T>); static;
class procedure MergeSort<T>(AArray: TArray<T>; FirstIndex, LastIndex: Integer; const AComparer: IComparer<T>); static;
end;
implementation
class procedure TMySort.InsertionSort<T>(AArray: TArray<T>; FirstIndex, LastIndex: Integer; const AComparer: IComparer<T>);
var
UnsortedIdx, CompareIdx: Integer;
AItem: T;
begin
for UnsortedIdx := Succ(FirstIndex) to LastIndex do begin
AItem := AArray[UnsortedIdx];
CompareIdx := UnsortedIdx - 1;
while (CompareIdx >= FirstIndex) and (AComparer.Compare(AItem, AArray[CompareIdx]) < 0) do begin
AArray[CompareIdx + 1] := AArray[CompareIdx]; { shift the compared (bigger) item to the right }
Dec(CompareIdx);
end;
AArray[CompareIdx + 1] := AItem;
end;
end;
class procedure TMySort.MergeSort<T>(AArray: TArray<T>; FirstIndex, LastIndex: Integer; const AComparer: IComparer<T>);
const
MinMergeSortLimit = 16;
var
LeftLast, RightFirst: Integer;
LeftIdx, RightIdx, SortedIdx: Integer;
LeftCount: Integer;
TmpLeftArray: TArray<T>;
begin
if (LastIndex - FirstIndex) < MinMergeSortLimit then
{ sort small chunks with insertion sort (recursion ends here)}
TMySort.InsertionSort<T>(AArray, FirstIndex, LastIndex, AComparer)
else begin
{ MERGE SORT }
{ calculate the index for splitting the array in left and right halves }
LeftLast := (FirstIndex + LastIndex) div 2;
RightFirst := LeftLast + 1;
{ sort both halves of the array recursively }
TMySort.MergeSort<T>(AArray, FirstIndex, LeftLast, AComparer);
TMySort.MergeSort<T>(AArray, RightFirst, LastIndex, AComparer);
{ copy the first half of the array to a temporary array }
LeftCount := LeftLast - FirstIndex + 1;
TmpLeftArray := System.Copy(AArray, FirstIndex, LeftCount);
{ setup the loop variables }
LeftIdx := 0; { left array to merge -> moved to TmpLeftArray, starts at index 0 }
RightIdx := RightFirst; { right array to merge -> second half of AArray }
SortedIdx := FirstIndex - 1; { range of merged items }
{ merge item by item until one of the arrays is empty }
while (LeftIdx < LeftCount) and (RightIdx <= LastIndex) do begin
{ get the smaller item from the next items in both arrays and move it
each step will increase the sorted range by 1 and decrease the items still to merge by 1}
Inc(SortedIdx);
if AComparer.Compare(TmpLeftArray[LeftIdx], AArray[RightIdx]) <= 0 then begin
AArray[SortedIdx] := TmpLeftArray[LeftIdx];
Inc(LeftIdx);
end else begin
AArray[SortedIdx] := AArray[RightIdx];
Inc(RightIdx);
end;
end;
{ copy the rest of the left array, if there is any}
while (LeftIdx < LeftCount) do begin
Inc(SortedIdx);
AArray[SortedIdx] := TmpLeftArray[LeftIdx];
Inc(LeftIdx);
end;
{ any rest of the right array is already in place }
end;
end;
The implementation is made for arrays and applicable for TList/TObjectList too (as their Items property is an array).
var
AList: TList<T>;
AComparer: IComparer<T>;
begin
...
TMySort.MergeSort<T>(AList.List, 0, AList.Count-1, AComparer);
...
end;
Besides being stable, in my experience, this merge sort implementation does show better performance than the build-in quick sort (though it uses more memory).
© 2022 - 2024 — McMap. All rights reserved.