Implementing TObjectList's sort without copy/paste code

Question

I have a procedure for sorting nodes in a node tree (VirtualTreeView) All memory leaks, extracted from FMM4 report, are stored in objects of a class TMemoryLeakList(these are the list I want to sort), which are stored in a list of lists called TGroupedMemoryLeakList, and both TMLL and TGMLL extend TObjectList. If I want to keep the functionality of being able to chose between ascending and descending sort order and choosing between sorting by one of four different data types, I 'have to' implement EIGHT different comparison methods (4 sort types * 2 sort directions) which I pass on to the main sorting method, because my TMLL list extends TObjectList. The main sorting method look like this.

The values for the fields fSortType and fSortDirection are acquired from the GUI comboboxes. One of those eight generic comparison functions looks like this. The seven remaining are copy/pasted variations of this one.

Is there any rational way to refactor this huge amount of copy paste code and still keep the functionality of choosing a specific sort type and direction?

Answer 1

Nice question about refactoring, but I dislike the answer you presumably are looking for. There is nothing wrong with a few extra lines of code, or a few extra routines. Especially the latter in which case naming actively assist in more readability.

My advice would be: leave the design as you have, but shorten the code:

function CompareSizeAsc(Item1, Item2: Pointer): Integer;
begin
  Result := TMemoryLeak(Item2).Size - TMemoryLeak(Item1).Size;
end;

function CompareSizeDesc(Item1, Item2: Pointer): Integer;
begin
  Result := TMemoryLeak(Item1).Size - TMemoryLeak(Item2).Size;
end;

function CompareClassNameAsc(Item1, Item2: Pointer): Integer;
begin
  Result := CompareStr(TMemoryLeak(Item1).ClassName,
    TMemoryLeak(Item2).ClassName);
end;

procedure TMemoryLeakList.Sort;
begin
  case FSortDirection of
    sdAsc:
      case FSortType of
        stSize: inherited Sort(CompareSizeAsc);
        stClassName: inherited Sort(CompareClassNameAsc);
        stCallStackSize: inherited Sort(CompareCallStackSizeAsc);
        stId: inherited Sort(CompareIdAsc);
      end;
    sdDesc:
      case FSortType of
        stSize: inherited Sort(CompareSizeDesc);
        stClassName: inherited Sort(CompareClassNameDesc);
        stCallStackSize: inherited Sort(CompareCallStackSizeDesc);
        stId: inherited Sort(CompareIdDesc);
      end;
  end;
end;

You can't get it much smaller then this ánd preserve the same level of readability.

Of course, you could rewrite the Sort routine as suggested by Arioch 'The:

procedure TMemoryLeakList.Sort;
const
  Compares: array[TSortDirection, TSortType] of TListSortCompare =
    ((CompareSizeAsc, CompareClassNameAsc, CompareCallStackSizeAsc,
    CompareIdAsc), (CompareSizeDesc, CompareClassNameDesc,
    CompareCallStackSizeDesc, CompareIdDesc));
begin
  inherited Sort(Compares[FSortDirection, FSortType]);
end;

But then: why not rewrite the QuickSort routine to eliminate the need for separate compare routines?

Alternatively, you could add ownership to TMemoryLeak in which case you have a reference to the owning list and its sort direction and sort type, for use within óne single compare routine.

Answer 2

Use function pointers.

var comparator1, comparator2: function (Item1, Item2: Pointer): Integer;

function sortComplex (Item1, Item2: Pointer): Integer;
begin
  Result := comparator1(Item1, Item2);
  if 0 = Result then   Result := comparator2(Item1, Item2);
end;

Then you GUI elements should behave like

 case ListSortType.ItemIndex of
    itemBySzie : comparator1 := sortBySizeProcAsc;
....
 end;

 DoNewSort;

PS: make sure that you correctly specify those pointers even before user 1st click any GUI element;

PPS: you can rearrange this even further like

 type t_criteria = (bySize, byName,...);
      t_comparators = array[t_criteria] of array [boolean {Descending?}]
                      of function (Item1, Item2: Pointer): Integer;

 const comparator1table: t_comparators = 
       ( {bySize} ( {false} sortBySizeProcAsc, {true} sortBySizeProcDesc),
         {byName} ( {false} sortByNameProcAsc, ...

Then you would fill working pointers from that array constants

Answer 3

This is my solution. Apart from completely rewriting the two procedures I also added two 'static' variables to my TMemoryLeakList class, and removed the former instance variables of the same name. This way, they are globally accessible to the Sort function.

TMemoryLeakList=class(TObjectList)
class var fSortType      :TMlSortType;
class var fSortDirection :TMLSortDirection;
...
end

procedure TMemoryLeakList.Sort;
begin
  inherited sort(sortBySomethingSomething);
end;

function sortBySomethingSomething(Item1, Item2: Pointer): Integer;
var
 a, b : string;
 ret : Integer;
begin
  ret := 1;
  if(TMemoryLeakList.fSortDirection = sdAsc) then
     ret := -1;
  case TMemoryLeakList.fSortType of stSize:
  begin
    a := IntToStr(TMemoryLeak(Item1).Size);
    b := IntToStr(TmemoryLeak(Item2).Size);
  end;
  end;
  case TMemoryLeakList.fSortType of stClassName:
  begin
    a := TMemoryLeak(Item1).ClassName;
    b := TMemoryLeak(Item2).ClassName;
  end;
  end;
  case TMemoryLeakList.fSortType of stID:
  begin
    a := IntToStr(TMemoryLeak(Item1).ID);
    b := IntToStr(TMemoryLeak(Item2).ID);
  end;
  end;
  case TMemoryLeakList.fSortType of stCallStackSize:
  begin
    a := IntToStr(TMemoryLeak(Item1).CallStack.Count);
    b := IntToStr(TMemoryLeak(Item2).CallStack.Count);
  end;
  end;
  //...jos tu
  if a=b then
    Result:=0
  else if a>b then
    Result:=-1*ret
  else if a<b then
    Result:=1*ret;
end;

I would like to rewrite this solution so as to use instance bounded variables fSortType,fSortDirection in TMemoryLeakList, but it seems impossible to pass a member function to an inherited sort function (from TObjectList), or is it?