To sort TObjectList with multiple criteria

Question

Looking into the example How to make an Excel-Like Sort By A, Then By B in a TObjectList<> using multiple comparers I have built the following test

program Project3;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.Generics.Defaults,
  System.Generics.Collections,
  System.Contnrs,
  System.SysUtils;

type
  TPerson = class(TObject)
    age: Integer;
    name: string;
  public
    constructor Create(aAge: Integer; aName: string); reintroduce;
  end;

  TSortCriterion<T> = class(TObject)
    Ascending: Boolean;
    Comparer: IComparer<T>;
  end;

  TSortCriteriaComparer<T> = class(TComparer<T>)
  private
    SortCriteria: TObjectList<TSortCriterion<T>>;
  public
    constructor Create;
    destructor Destroy; override;
    function Compare(const Right, Left: T): Integer; override;
    procedure ClearCriteria; virtual;
    procedure AddCriterion(NewCriterion: TSortCriterion<T>); virtual;
  end;

  TPersonAgeComparer = class(TComparer<TPerson>)
  public
    function Compare(const Left, Right: TPerson): Integer; override;
  end;

  TPersonLastNameComparer = class(TComparer<TPerson>)
  public
    function Compare(const Left, Right: TPerson): Integer; override;
  end;

{ TSortCriteriaComparer<T> }

procedure TSortCriteriaComparer<T>.AddCriterion(NewCriterion: TSortCriterion<T>);
begin
  SortCriteria.Add(NewCriterion);
end;

procedure TSortCriteriaComparer<T>.ClearCriteria;
begin
  SortCriteria.Clear;
end;

function TSortCriteriaComparer<T>.Compare(const Right, Left: T): Integer;
var
  Criterion: TSortCriterion<T>;
begin
  for Criterion in SortCriteria do
  begin
    Result := Criterion.Comparer.Compare(Right, Left);
    if not Criterion.Ascending then
      Result := -Result;
    if Result <> 0 then
      Exit;
  end;
end;

constructor TSortCriteriaComparer<T>.Create;
begin
  inherited;
  SortCriteria := TObjectList<TSortCriterion<T>>.Create(True);
end;

destructor TSortCriteriaComparer<T>.Destroy;
begin
  SortCriteria.Free;
  inherited;
end;



{ TPersonAgeComparer }

function TPersonAgeComparer.Compare(const Left, Right: TPerson): Integer;
begin
  if Left.age > Right.age then
    Result := -1
  else if Left.age < Right.age then
    result := 1
  else
    result := 0;
end;

{ TPersonLastNameComparer }

function TPersonLastNameComparer.Compare(const Left, Right: TPerson): Integer;
begin
  if Left.name > Right.name then
    Result := -1
  else if Left.name < Right.name then
    result := 1
  else
    result := 0;
end;

{ TPerson }

constructor TPerson.Create(aAge: Integer; aName: string);
begin
  Age := aAge;
  name := aName;
end;

var
  PersonComparer: TSortCriteriaComparer<TPerson>;
  Criterion: TSortCriterion<TPerson>;
  PeopleList: TObjectList<TPerson>;
  Person: TPerson;

begin
  PersonComparer := TSortCriteriaComparer<TPerson>.Create;
  try
    Criterion := TSortCriterion<TPerson>.Create;
    Criterion.Ascending := True;
    Criterion.Comparer := TPersonAgeComparer.Create;
    PersonComparer.AddCriterion(Criterion);
    Criterion := TSortCriterion<TPerson>.Create;
    Criterion.Ascending := True;
    Criterion.Comparer := TPersonLastNameComparer.Create;
    PersonComparer.AddCriterion(Criterion);

    PeopleList := TObjectList<TPerson>.Create;
    PeopleList.Sort(PersonComparer);

    Person := TPerson.Create(26, 'Smith');
    PeopleList.Add(Person);

    Person := TPerson.Create(26, 'Jones');
    PeopleList.Add(Person);

    Person := TPerson.Create(24, 'Jones');
    PeopleList.Add(Person);

    Person := TPerson.Create(34, 'Lincoln');
    PeopleList.Add(Person);

  finally
    PersonComparer.Free;
  end;
end.

but instead of giving the following outcome

Lastname ▲   Age ▲
---------------------
Jones        24
Jones        26
Smith        26
Lincoln      34

I have this one

Lastname ▲   Age ▲
---------------------
Smith        26
Jones        26
Jones        24
Lincoln      34

I tried to change TPersonLastNameComparer.Comparer and TPersonAgeComparer.Comparer but I cannot get the desided outcome.

What am I doing wrong ?

You sort when the list is empty and then populate it. Populate it first then sort it. Also, you add the criteria in the wrong order I think. — David Heffernan, Nov 29 '21 at 18:40
@DavidHeffernan Thank you very much, David. I was under the impression that TObjectList.Sort should be set at the beginning and the list would be kept sorted automatically. Thinking about that it makes more sense TObjectList has to be sorted when needed. You were right on the comparer too, it should be the other way round. — pio pio, Nov 29 '21 at 21:16

pio pio · Answer 1 · 2021-11-29T21:34:16.387

Thanks to the input from David I was able to fix this. Here the correct code:

program Project3;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.Generics.Defaults,
  System.Generics.Collections,
  System.Contnrs,
  System.SysUtils;

type
  TPerson = class(TObject)
    age: Integer;
    name: string;
  public
    constructor Create(aAge: Integer; aName: string); reintroduce;
  end;

  TSortCriterion<T> = class(TObject)
    Ascending: Boolean;
    Comparer: IComparer<T>;
  end;

  TSortCriteriaComparer<T> = class(TComparer<T>)
  private
    SortCriteria: TObjectList<TSortCriterion<T>>;
  public
    constructor Create;
    destructor Destroy; override;
    function Compare(const Right, Left: T): Integer; override;
    procedure ClearCriteria; virtual;
    procedure AddCriterion(NewCriterion: TSortCriterion<T>); virtual;
  end;

  TPersonAgeComparer = class(TComparer<TPerson>)
  public
    function Compare(const Left, Right: TPerson): Integer; override;
  end;

  TPersonLastNameComparer = class(TComparer<TPerson>)
  public
    function Compare(const Left, Right: TPerson): Integer; override;
  end;

{ TSortCriteriaComparer<T> }

procedure TSortCriteriaComparer<T>.AddCriterion(NewCriterion: TSortCriterion<T>);
begin
  SortCriteria.Add(NewCriterion);
end;

procedure TSortCriteriaComparer<T>.ClearCriteria;
begin
  SortCriteria.Clear;
end;

function TSortCriteriaComparer<T>.Compare(const Right, Left: T): Integer;
var
  Criterion: TSortCriterion<T>;
begin
  for Criterion in SortCriteria do
  begin
    Result := Criterion.Comparer.Compare(Right, Left);
    if not Criterion.Ascending then
      Result := -Result;
    if Result <> 0 then
      Exit;
  end;
end;

constructor TSortCriteriaComparer<T>.Create;
begin
  inherited;
  SortCriteria := TObjectList<TSortCriterion<T>>.Create(True);
end;

destructor TSortCriteriaComparer<T>.Destroy;
begin
  SortCriteria.Free;
  inherited;
end;



{ TPersonAgeComparer }

function TPersonAgeComparer.Compare(const Left, Right: TPerson): Integer;
begin
  if Left.age > Right.age then
    Result := 1
  else if Left.age < Right.age then
    result := -1
  else
    result := 0;
end;

{ TPersonLastNameComparer }

function TPersonLastNameComparer.Compare(const Left, Right: TPerson): Integer;
begin
  if Left.name > Right.name then
    Result := 1
  else if Left.name < Right.name then
    result := -1
  else
    result := 0;
end;

{ TPerson }

constructor TPerson.Create(aAge: Integer; aName: string);
begin
  Age := aAge;
  name := aName;
end;

var
  PersonComparer: TSortCriteriaComparer<TPerson>;
  Criterion: TSortCriterion<TPerson>;
  PeopleList: TObjectList<TPerson>;
  Person: TPerson;

begin
  PersonComparer := TSortCriteriaComparer<TPerson>.Create;
  try
    Criterion := TSortCriterion<TPerson>.Create;
    Criterion.Ascending := True;
    Criterion.Comparer := TPersonAgeComparer.Create;
    PersonComparer.AddCriterion(Criterion);
    Criterion := TSortCriterion<TPerson>.Create;
    Criterion.Ascending := True;
    Criterion.Comparer := TPersonLastNameComparer.Create;
    PersonComparer.AddCriterion(Criterion);

    PeopleList := TObjectList<TPerson>.Create;


    Person := TPerson.Create(26, 'Smith');
    PeopleList.Add(Person);

    Person := TPerson.Create(26, 'Jones');
    PeopleList.Add(Person);

    Person := TPerson.Create(24, 'Jones');
    PeopleList.Add(Person);

    Person := TPerson.Create(34, 'Lincoln');
    PeopleList.Add(Person);

    PeopleList.Sort(PersonComparer);

  finally
    PersonComparer.Free;
    TradeList.Free;
  end;
end.

To sort TObjectList with multiple criteria

1 Answers1