How do I sort a generic list using a custom comparer?

Question

I'm kinda a Delphi-newbie and I don't get how the Sort method of a TList of Records is called in order to sort the records by ascending integer value. I have a record like the following:

 type
   TMyRecord = record
     str1: string;
     str2: string;
     intVal: integer;
   end;

And a generic list of such records:

TListMyRecord = TList<TMyRecord>;

Have tried to find a code-example in the help files and found this one:

MyList.Sort(@CompareNames);

Which I can't use, since it uses classes. So I tried to write my own compare function with a little different parameters:

function CompareIntVal(i1, i2: TMyRecord): Integer;
begin
  Result := i1.intVal - i2.intVal;
end;

But the compiler always throws a 'not enough parameters' - error when I call it with open.Sort(CompareIntVal);, which seems obvious; so I tried to stay closer to the help file:

function SortKB(Item1, Item2: Pointer): Integer;
begin
  Result:=PMyRecord(Item1)^.intVal - PMyRecord(Item2)^.intVal;
end;

with PMyRecord as PMyRecord = ^TMyRecord;

I have tried different ways of calling a function, always getting some error...

Overnight

Answer 1

The Sort overload you should be using is this one:

procedure Sort(const AComparer: IComparer<TMyRecord>);

Now, you can create an IComparer<TMyRecord> by calling TComparer<TMyRecord>.Construct. Like this:

var
  Comparison: TComparison<TMyRecord>;
....
Comparison := 
  function(const Left, Right: TMyRecord): Integer
  begin
    Result := Left.intVal-Right.intVal;
  end;
List.Sort(TComparer<TMyRecord>.Construct(Comparison));

I've written the Comparison function as an anonymous method, but you could also use a plain old style non-OOP function, or a method of an object.

One potential problem with your comparison function is that you may suffer from integer overflow. So you could instead use the default integer comparer.

Comparison := 
  function(const Left, Right: TMyRecord): Integer
  begin
    Result := TComparer<Integer>.Default.Compare(Left.intVal, Right.intVal);
  end;

It might be expensive to call TComparer<Integer>.Default repeatedly so you could store it away in a global variable:

var
  IntegerComparer: IComparer<Integer>;
....
initialization
  IntegerComparer := TComparer<Integer>.Default;

Another option to consider is to pass in the comparer when you create the list. If you only ever sort the list using this ordering then that's more convenient.

List := TList<TMyRecord>.Create(TComparer<TMyRecord>.Construct(Comparison));

And then you can sort the list with

List.Sort;

Renewal

Thanks verry much! Do I need to include anything in 'uses' besides the uses Generics.Collections,..., 'cause I get an 'undeclared' for TComparisonand IComparerin var Comparison: TComparison<TKanteRecord>; IntegerComparer: IComparer<Integer>;? – Overnight

You also need Generics.Defaults. Have you found the RTL source code yet. That would help you. – Renewal

@David, are you sure TComparer is a good choice for a code you provided ? TComparer is meant to be the abstract base class. I'd suggest to use TDelegatedComparer for your code. – Tillie

@Tillie Yes I am sure of that: TComparer<T>.Construct(Comparison) is implemented with a call to TDelegatedComparer<T>.Create(Comparison). – Renewal

@DavidHeffernan The TList<T> does not have a constructor that accept a TComparer<T> as an input parameter in Delphi 10.2. Could you give compilable examples? – Irs

@Bitman The code here does compile. It does not pass a TComparer<T> to any constructor. – Renewal

@DavidHeffernan Definitely not! I interested in your last "solution" that uses a TList<T>.create( IComparer<T> ) constructor and a parameterless TList<T>.Sort method call. – Irs

@bitman I'm pretty sure it compiles but I can't check right now – Renewal

@bitman As I thought, the code in the answer compiles. You must have transcribed it incorrectly. – Renewal

@DavidHeffernan As I wrote. I was interested in the second solution. The section after "Another option...". There is no example for this solution. – Irs

@bitman yes there is, that's the code I checked, and it compiles just fine. Instead of asking what's wrong with my code you'll need to study yours. You made a mistake somewhere. – Renewal

Answer 2

The concise answer:

uses
  .. System.Generics.Defaults // Contains TComparer

myList.Sort(
  TComparer<TMyRecord>.Construct(
    function(const Left, Right: TMyRecord): Integer
    begin
      Result := Left.intVal - Right.intVal;
    end
  )
);

Tuesday

Answer 3

I want to share my solution (based on the input I have gathered here).

It's a standard setup. A filedata class that holds data of a single file in a generic TObjectList. The list has the two private attributes fCurrentSortedColumn and fCurrentSortAscending to control the sort order. The AsString-method is the path and filename combined.

function TFileList.SortByColumn(aColumn: TSortByColums): boolean;
var
  Comparison: TComparison<TFileData>;
begin
  result := false;
  Comparison := nil;

  case aColumn of
    sbcUnsorted   : ;
    sbcPathAndName: begin
                      Comparison := function(const Left, Right: TFileData): integer
                                    begin
                                      Result := TComparer<string>.Default.Compare(Left.AsString,Right.AsString);
                                    end;
                    end;
    sbcSize       : begin
                      Comparison := function(const Left, Right: TFileData): integer
                                    begin
                                      Result := TComparer<int64>.Default.Compare(Left.Size,Right.Size);
                                      if Result = 0 then
                                        Result := TComparer<string>.Default.Compare(Left.AsString,Right.AsString);
                                    end;
                    end;
    sbcDate       : begin
                      Comparison := function(const Left, Right: TFileData): integer
                                    begin
                                      Result := TComparer<TDateTime>.Default.Compare(Left.Date,Right.Date);
                                      if Result = 0 then
                                        Result := TComparer<string>.Default.Compare(Left.AsString,Right.AsString);
                                    end;
                    end;
    sbcState      : begin
                      Comparison := function(const Left, Right: TFileData): integer
                                    begin
                                      Result := TComparer<TFileDataTestResults>.Default.Compare(Left.FileDataResult,Right.FileDataResult);
                                      if Result = 0 then
                                        Result := TComparer<string>.Default.Compare(Left.AsString,Right.AsString);
                                    end;
                     end;
  end;

  if assigned(Comparison) then
  begin
    Sort(TComparer<TFileData>.Construct(Comparison));

    // Control the sort order
    if fCurrentSortedColumn = aColumn then
      fCurrentSortAscending := not fCurrentSortAscending
    else begin
      fCurrentSortedColumn := aColumn;
      fCurrentSortAscending := true;
    end;

    if not fCurrentSortAscending then
      Reverse;

    result := true;
  end;
end;

Angy

Answer 4

I found a much simpler modified sort function to alphabetize a TList of records or nonstandard list of items.

Example

PList = ^TContact;
    TContact = record             //Record for database of user contact records
      firstname1 : string[20];
      lastname1 : string[20];
       phonemobile : Integer;       //Fields in the database for contact info
      phonehome : Integer;
      street1 : string;
      street2 : string;

 type
    TListSortCompare = function (Item1,
                                Item2: TContact): Integer;
var
  Form1: TForm1;
  Contact : PList;         //declare record database for contacts
  arecord : TContact;
  Contacts : TList;   //List for the Array of Contacts

function CompareNames(i1, i2: TContact): Integer;
begin
   Result := CompareText(i1.lastname1, i2.lastname1) ;
end;

and the function to call to sort your list

Contacts.Sort(@CompareNames);

Nineteenth

You might want to clean up your code sample a bit. Remove unused variables. Add usage example. Correct the syntax. – Sprite

The original question was about sorting a generic list, while this example is using the standard TList (list of pointers), which is a different scenario. – Titanomachy

Answer 5

unit API.Generics;

interface
uses
  System.Classes
//
, System.Generics.Collections
, System.Generics.Defaults
  ;

type
  TSort = (sNone, sAsc, sDes);

  TDynamicObjectList<T: class> = class(TObjectList<T>)
  private
    fComparer: TComparison<T>;
    fSortField: string;
    fSort: TSort;
    function CompareNumbers(const L, R: Integer): Integer;
    function CompareObjects(const aLeft, aRight: T): Integer;
  public
    constructor CreateWithSort(const aSortField: string; aSort: TSort = sAsc);
    procedure Sort(aSort: TSort = sAsc);
    function IsSortedCorrectly: Boolean;
  end;

implementation

uses
  System.SysUtils
, System.Rtti
, System.TypInfo
  ;

{ TDynamicObjectList<T> }

constructor TDynamicObjectList<T>.CreateWithSort(const aSortField: string; aSort: TSort);
begin inherited Create(True);

  fSortField := aSortField;
  fSort      := aSort;

  fComparer  := CompareObjects;
end;

function TDynamicObjectList<T>.CompareNumbers(const L, R: Integer): Integer;
begin
  Result := L - R;
end;

function TDynamicObjectList<T>.CompareObjects(const aLeft, aRight: T): Integer;
var
  L_Ctx       : TRttiContext;
  L_Typ       : TRttiType;
  L_Prop      : TRttiProperty;
  L_Left      : TClass absolute aLeft;
  L_Right     : TClass absolute aRight;

  L_LeftValue,
  L_RightValue: TValue;
begin
  if fSortField = '' then
  begin
    // Use default comparer if no specific field is specified ..
    Result := TComparer<T>.Default.Compare(T(L_Left), T(L_Right));
    Exit;
  end;

  L_Ctx := TRttiContext.Create;
  try
    L_Typ  := L_Ctx.GetType(T); // Get RTTI for type ( T )
    L_Prop := nil;
    L_Prop := L_Typ.GetProperty(fSortField);

    if Assigned(L_Prop) then
    begin
      L_LeftValue    := L_Prop.GetValue(L_Left);
      L_RightValue   := L_Prop.GetValue(L_Right);

      case L_LeftValue.Kind of
       tkInteger, tkInt64:
         case fSort of
           sAsc: Result := CompareNumbers(L_LeftValue.AsInteger, L_RightValue.AsInteger);
           sDes: Result := CompareNumbers(L_RightValue.AsInteger, L_LeftValue.AsInteger);
         else
          Result := TComparer<T>.Default.Compare(T(L_Left), T(L_Right));
         end;
       tkString, tkWString, tkLString, tkUString:
         case fSort of
           sAsc: Result := CompareNumbers(Integer.Parse(L_LeftValue.AsString),
                                          Integer.Parse(L_RightValue.AsString));
           sDes: Result := CompareNumbers(Integer.Parse(L_LeftValue.AsString),
                                          Integer.Parse(L_RightValue.AsString));
         else
           Result := TComparer<T>.Default.Compare(T(L_Left), T(L_Right));
         end;
      else
        TComparer<T>.Default.Compare(T(L_Left), T(L_Right));
      end;
    end
    else
      Result := 0; // Handle case where property is not found
  finally
    L_Ctx.Free;
  end;
end;

function TDynamicObjectList<T>.IsSortedCorrectly: Boolean;
var
  I: Integer;
begin
  Result := True;
  for I := 1 to Count - 1 do
  begin
    if CompareObjects(Items[I - 1], Items[I]) > 0 then
    begin
      Result := False;
      Break;
    end;
  end;
end;

procedure TDynamicObjectList<T>.Sort(aSort: TSort);
begin
  fSort := aSort;

  inherited Sort(TComparer<T>.Construct(fComparer));
end;

end.    

using code:

in separate Unit: MyFonts.pas
type
  TFonType = (ft_TTF, ft_OTF, ft_Unknown);

  TFontInfo = class
  strict private
    fFileID,
    fFontName    : string;
    fFontType    : TFonType;
    fFontFileName: string;
  private
    function Get_FontType: string; procedure Set_FontType(const aValue: string);
  public
    constructor Add(const aFileID, aFontName: string; const aFontType: TFonType);
    destructor Destroy; override;

    property ID: string           read fFileID       write fFileID;
    property FontName:string      read fFontName     write fFontName;
    property FontType:string      read Get_FontType  write Set_FontType;
    property FontFileName: string read fFontFileName write fFontFileName;
  end;

  TFontsList = class(TDynamicObjectList<TFontInfo>);

in MainForm:
uses MyFonts;

type
  TMainView = class(TForm)
    LV_Fonts: TListView;
    procedure FormCreate(Sender: TObject);
  private
    fFontsLst: TFontsList;
    { Private declarations }
  public
    { Public declarations }
  end;

implementation

procedure TMainView.FormCreate(Sender: TObject);
var
  L_FontInfo: TFontInfo;
  L_ListItem: TListItem;
begin
  fFontsLst:= TFontsList.CreateWithSort('ID'); 
  
   // Add some sample data
  fFontsLst.Add(TFontInfo.Add('3', 'Courier New', ft_TTF));
  fFontsLst.Add(TFontInfo.Add('1', 'Arial', ft_TTF));
  fFontsLst.Add(TFontInfo.Add('2', 'Times New Roman', ft_OTF));

  // Sort the list by ID in default Asc sort
  fFontsLst.Sort;
  
  // Populate the ListView
  for L_FontInfo in fFontsLst do begin
    L_ListItem := LV_Fonts.Items.Add;
    L_ListItem.Caption := L_FontInfo.ID;
    L_ListItem.SubItems.Add(L_FontInfo.FontName);
    L_ListItem.SubItems.Add(L_FontInfo.FontType);
    L_ListItem.SubItems.Add(L_FontInfo.FontFileName);
  end;   
   
end; 
 
procedure TMainView.FormDestroy(Sender: TObject);
begin
  fFontsLst.Free;
end;

currentlly it's works only with fields marked as string or integer but real value are in integer and sorted using : CompareNumbers

Jadejaded

Your answer could be improved with additional supporting information. Please edit to add further details, such as citations or documentation, so that others can confirm that your answer is correct. You can find more information on how to write good answers in the help center. – Mayfield