Easy way to add stable sorting to TList and TStringList

Question

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?

Answer 1

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:

• If you are sure that an index is < 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;
• The comparison function is most of the time the speed bottleneck of the search - so take care of this part;
• If you need speed, use a real profiler over real (e.g. random) data - but make it right before making it fast;
• Start from an existing implementation of the sort;
• To minimize stack space, you may use a temporary record to store and share variables among recursive calls.

Answer 2

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).

Answer 3

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

Answer 4

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);