Delphi 向TList和TStringList添加稳定排序的简单方法

我使用TList/TObjectList和TStringList（以及相关的对象）执行大量任务，既可以按原样执行，也可以作为更复杂结构的基础。虽然排序功能通常足够好，但有时我需要进行排序，并且两个列表都使用快速排序

---

为TList和/或TStringList实现稳定排序的最简单方法是什么？我是否必须编写自己的排序例程，或者可以通过使用TStringListSortCompare/TListSortCompare的一些巧妙技巧来完成它？

您必须编写自己的排序例程

您可以阅读当前的快速排序实现，并编写您自己的稳定版本（例如，合并或排序）

一些技巧：

• 如果确定索引是<

  Count

  ，则可以使用快速指针数组（

  TList.List[]

  ），而不是较慢的

  项[]

  或

  GetItem（）

  ：子方法调用和范围检查会减慢执行速度
• 比较功能在大多数情况下是搜索速度的瓶颈-所以要注意这一部分
• 如果您需要速度，请使用真实（如随机）数据的真实探查器，但要在使其快速之前正确进行
• 从排序的现有实现开始
• 为了最小化堆栈空间，可以使用临时记录在递归调用之间存储和共享变量

---

这个问题已经很老了，但下面是我给未来读者的答案： 我最近也需要它，并修改了Julian Bucknall在《Delphi算法和数据结构的大部头》一书中的实现。TList、TObjectList和子类的实现。它适用于Delphi 2009至XE7，也可能适用于其他版本：

类似的问题，在lkessler的评论中链接到这里，我需要复制到这里，这是问题中提到的非常简单的技巧

只需将初始订单号添加到数据中进行排序，并在CustomSort compare函数中添加最后一个比较条件以比较此初始订单号，即可轻松使快速排序行为稳定

简单、快速、智能。在每个可排序项上只额外花费一个整数（或字节，或者在对TComponents排序时使用一些保留存储，如TComponents.Tag）和一个初始化循环

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

---

对于任何使用泛型的人来说，这里是插入和合并排序的现成实现，这两种排序算法都是稳定的

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;

使用泛型.默认值，泛型.集合；
类型
TMySort=类
公众的
类过程插入排序（AArray:TArray；FirstIndex，LastIndex:Integer；const-AComparer:IComparer）；静止的
类过程MergeSort（AArray:TArray；FirstIndex，LastIndex:Integer；const AComparer:IComparer）；静止的
结束；
实施
类过程TMySort.InsertionSort（AArray:TArray；FirstIndex，LastIndex:Integer；const-AComparer:IComparer）；
变量
unsortedix，CompareIdx：整数；
AItem:T；
开始
对于unsortedix:=such（FirstIndex）to LastIndex do begin
AItem:=AArray[unsortedix]；
CompareIdx:=UnsortedIdx-1；
而（CompareIdx>=FirstIndex）和（AComparer.Compare（AItem，AArray[CompareIdx]）<0）确实开始
AArray[CompareIdx+1]：=AArray[CompareIdx]；{将比较的（较大的）项向右移动}
Dec（CompareIdx）；
结束；
AArray[CompareIdx+1]：=AItem；
结束；
结束；
类过程TMySort.MergeSort（AArray:TArray；FirstIndex，LastIndex:Integer；const-AComparer:IComparer）；
常数
MinMergeSortLimit=16；
变量
LeftLast、RightFirst：整数；
LeftIdx、RightIdx、SortedIdx：整数；
LeftCount：整数；
TmpLeftArray:TArray；
开始
如果（LastIndex-FirstIndex）移动到TmpLeftArray，从索引0开始}
RightIdx:=RightFirst；{要合并的右数组->AArray的后半部分}
SORTEDIX:=第一索引-1；{合并项的范围}
{逐项合并，直到其中一个数组为空}
虽然（LeftIdxvar
  AList: TList<T>;
  AComparer: IComparer<T>;
begin
  ...
  TMySort.MergeSort<T>(AList.List, 0, AList.Count-1, AComparer);
  ...
end;