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 functionali

Answer 1

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(AArray: TArray; FirstIndex, LastIndex: Integer; const AComparer: IComparer); static;
    class procedure MergeSort(AArray: TArray; FirstIndex, LastIndex: Integer; const AComparer: IComparer); static;
  end;

implementation

class procedure TMySort.InsertionSort(AArray: TArray; FirstIndex, LastIndex: Integer; const AComparer: IComparer);
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(AArray: TArray; FirstIndex, LastIndex: Integer; const AComparer: IComparer);
const
  MinMergeSortLimit = 16;
var
  LeftLast, RightFirst: Integer;
  LeftIdx, RightIdx, SortedIdx: Integer;
  LeftCount: Integer;
  TmpLeftArray: TArray;
begin
  if (LastIndex - FirstIndex) < MinMergeSortLimit then
    { sort small chunks with insertion sort (recursion ends here)}
    TMySort.InsertionSort(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(AArray, FirstIndex, LeftLast, AComparer);
    TMySort.MergeSort(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;
  AComparer: IComparer;
begin
  ...
  TMySort.MergeSort(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).