Recent

Author Topic: Sort Comparer function  (Read 2627 times)

jcmontherock

  • Full Member
  • ***
  • Posts: 234
Sort Comparer function
« on: August 02, 2022, 05:12:47 pm »
Hello,
I have a TList containing a class of data fields:
Code: Pascal  [Select][+][-]
  1.   TDataClass = Class
  2.     drInteger:    Integer;
  3.     drFloat:      Double;
  4.     drCharArray:  Array[0..400] of Char;
  5.     drDateTime:   TDateTime;
  6.     drString:     String[100];
  7.   end;
For sorting this list, I'am using TList.Sort with a comparer function.
 
Is somebody knows how to pass some parameters directly to the comparer function.
For ex. in that function I want know on which field of class, list will be sorted, and in which direction (ascending or descending).

Windows 11/64 Lazarus 222/64

Windows 11 UTF8-64 - Lazarus 3.2-64 - FPC 3.2.2

Zvoni

  • Hero Member
  • *****
  • Posts: 2319
Re: Sort Comparer function
« Reply #1 on: August 03, 2022, 08:40:28 am »
Use an Enum indicating the Field and a Boolean for Direction?
One System to rule them all, One Code to find them,
One IDE to bring them all, and to the Framework bind them,
in the Land of Redmond, where the Windows lie
---------------------------------------------------------------------
Code is like a joke: If you have to explain it, it's bad

MarkMLl

  • Hero Member
  • *****
  • Posts: 6676
Re: Sort Comparer function
« Reply #2 on: August 03, 2022, 09:49:45 am »
Use an Enum indicating the Field and a Boolean for Direction?

I suspect that he's asking about "best practice" for passing additional parameters into the comparison function, i.e. not provided for by the type that defines it.

Without a compilable example it's difficult to be sure.

MarkMLl
MT+86 & Turbo Pascal v1 on CCP/M-86, multitasking with LAN & graphics in 128Kb.
Pet hate: people who boast about the size and sophistication of their computer.
GitHub repositories: https://github.com/MarkMLl?tab=repositories

jcmontherock

  • Full Member
  • ***
  • Posts: 234
Re: Sort Comparer function
« Reply #3 on: August 03, 2022, 05:49:07 pm »
Find here an example. I want to have only one sort comparer function instead one for each type of field.
« Last Edit: August 03, 2022, 05:51:36 pm by jcmontherock »
Windows 11 UTF8-64 - Lazarus 3.2-64 - FPC 3.2.2

MarkMLl

  • Hero Member
  • *****
  • Posts: 6676
Re: Sort Comparer function
« Reply #4 on: August 03, 2022, 07:28:31 pm »
Find here an example. I want to have only one sort comparer function instead one for each type of field.

I think the interesting approach would be to move the comparer inside an instance of (a subclass of) TFPList, and have it refer to a field of the instance to find out how it should be sorting. I just don't know yet whether that could be done...

The /proper/ way is probably to subclass TFPList, and redefine Sort such that the comparer took an extra parameter. I don't know whether that could be done concisely.

If nobody else comes up with anything I'll try to have a play later.

MarkMLl
MT+86 & Turbo Pascal v1 on CCP/M-86, multitasking with LAN & graphics in 128Kb.
Pet hate: people who boast about the size and sophistication of their computer.
GitHub repositories: https://github.com/MarkMLl?tab=repositories

balazsszekely

  • Guest
Re: Sort Comparer function
« Reply #5 on: August 03, 2022, 08:06:56 pm »
@jcmontherock

Quote
Find here an example. I want to have only one sort comparer function instead one for each type of field.
Since you already declared two global variable( iSortCol,  bDirAsc), you can use a single comparer function, something like this:
Code: Pascal  [Select][+][-]
  1. function SortComp(Item1, Item2: Pointer): Integer;
  2. begin
  3.   Result := 0;
  4.   case iSortCol of
  5.     0: Result := TDataClass(Item1).drInteger - TDataClass(Item2).drInteger;
  6.     3: Result := CompareDateTime(TDataClass(Item1).drDateTime, TDataClass(Item2).drDateTime);
  7.     //..
  8.   end;
  9.   if bDirAsc = False then Result *= -1;
  10. end;
  11.  
  12. //...
  13.   bDirAsc := False;
  14.   iSortCol := 0;
  15.   DataList.Sort(SortComp);
  16.   ShowClassList;  
  17.  
Also you can subclass TFPList and write your own sort method, use generics, etc..., but if you wish to keep it simple the above method should work fine.

MarkMLl

  • Hero Member
  • *****
  • Posts: 6676
Re: Sort Comparer function
« Reply #6 on: August 03, 2022, 09:42:26 pm »
Since you already declared two global variable( iSortCol,  bDirAsc), you can use a single comparer function, something like this:

In haste, I'd overlooked the globals :-(

There really /must/ be an elegant way of moving those to somewhere less visible.

MarkMLl
MT+86 & Turbo Pascal v1 on CCP/M-86, multitasking with LAN & graphics in 128Kb.
Pet hate: people who boast about the size and sophistication of their computer.
GitHub repositories: https://github.com/MarkMLl?tab=repositories

Thausand

  • Sr. Member
  • ****
  • Posts: 292
Re: Sort Comparer function
« Reply #7 on: August 03, 2022, 09:52:13 pm »
There really /must/ be an elegant way of moving those to somewhere less visible.
I not know if elegant but...
Code: Pascal  [Select][+][-]
  1. program lister;
  2.  
  3. {$MODE OBJFPC}{$H+}
  4.  
  5. uses
  6.   classes,sysutils,dateutils;
  7.  
  8. const
  9.   tab=#09;
  10.  
  11. type
  12.   TFPDataListSortDirection=(sdAscending,sdDescending);
  13.   TFPDataSortCompareFunc=function(item1,item2:pointer;FieldName:string;SortDirection:TFPDataListSortDirection):integer;
  14.  
  15.   TFPDataList=class(TFPList)
  16.     procedure CustomSort(FieldName:string;SortDirection:TFPDataListSortDirection;Compare:TFPDataSortCompareFunc);
  17.     procedure CustomQuickSort(FList:PPointerList;L,R:Longint;Compare:TFPDataSortCompareFunc;FieldName:string;SortDirection:TFPDataListSortDirection);
  18.   end;
  19.  
  20.   TDataClass=class
  21.     drInteger:integer;
  22.     drFloat:double;
  23.     drCharArray:array[0..400] of Char;
  24.     drDateTime:TDateTime;
  25.     drString:string[100];
  26.   end;
  27.  
  28. var
  29.   DataList:TFPDataList;
  30.   DataClass:TDataClass;
  31.  
  32. function DataListSortCompare(item1,item2:pointer;FieldName:string;SortDirection:TFPDataListSortDirection):integer;
  33. begin
  34.   result:=0;
  35.   case FieldName of
  36.     'drInteger': if TDataClass(item1).drInteger<TDataClass(item2).drInteger then result:=-1 else
  37.                  if TDataClass(item1).drInteger>TDataClass(item2).drInteger then result:=1;
  38.     'drDateTime':result:=CompareDateTime(TDataClass(item1).drDateTime,TDataClass(item2).drDateTime);
  39.   end;
  40.   if SortDirection=sdDescending then result:=result*-1;
  41. end;
  42.  
  43. Procedure TFPDataList.CustomQuickSort(FList:PPointerList;L,R:Longint;Compare:TFPDataSortCompareFunc;FieldName:string;SortDirection:TFPDataListSortDirection);
  44. var
  45.   I,J,P:Longint;
  46.   PItem,Q:Pointer;
  47. begin
  48.  repeat
  49.    I:=L;
  50.    J:=R;
  51.    P:=(L+R)div 2;
  52.    repeat
  53.      PItem:=FList^[P];
  54.      while Compare(PItem,FList^[i],FieldName,SortDirection)>0 do
  55.        I:=I+1;
  56.      while Compare(PItem,FList^[J],FieldName,SortDirection)<0 do
  57.        J:=J-1;
  58.      if I<=J then
  59.      begin
  60.        Q:=FList^[I];
  61.        Flist^[I]:=FList^[J];
  62.        FList^[J]:=Q;
  63.        if P=I then
  64.         P:=J
  65.        else if P=J then
  66.         P:=I;
  67.        I:=I+1;
  68.        J:=J-1;
  69.      end;
  70.    until I>J;
  71.    if L<J then
  72.      CustomQuickSort(FList,L,J,Compare,FieldName,SortDirection);
  73.    L:=I;
  74.  until I>=R;
  75. end;
  76.  
  77. procedure TFPDataList.CustomSort(FieldName:string;SortDirection:TFPDataListSortDirection;Compare:TFPDataSortCompareFunc);
  78. begin
  79.   if not assigned(Self.List)or(Count<2) then exit;
  80.   CustomQuickSort(Self.List,0,Count-1,Compare,FieldName,SortDirection);
  81. end;
  82.  
  83. procedure CreateDataList(linecnt:integer);
  84. var
  85.   i:integer;
  86. begin
  87.   random;
  88.   for i:=1 to linecnt do
  89.   begin
  90.     DataClass:=TDataClass.Create;
  91.     DataClass.drInteger    := i;
  92.     DataClass.drFloat      := random(10000)*random();
  93.     //                         1...5...10...15...20...25...30...35...40...45...50
  94.     DataClass.drCharArray  := 'àààààààààààà '+i.ToString+' àààààààààààààbbbbb' +
  95.                               'éééééééééééé '+i.ToString+' éééééééééééééfffff';
  96.     DataClass.drDateTime   := IncMinute(Now+Random(60));
  97.     DataClass.drString     := 'We don''t use '+IntToStr(i)+' Tééést';
  98.     DataList.Add(DataClass);
  99.   end;
  100. end;
  101.  
  102. procedure ShowClassList(sTitle:string='');
  103. var
  104.   i:integer;
  105.   sline:string;
  106. begin
  107.   if sTitle<>'' then writeLn(sTitle+' : ');
  108.   for i:=0 to Pred(DataList.Count) do
  109.   begin
  110.     DataClass:=TDataClass(DataList[i]);
  111.     writestr(sline,'');
  112.     writestr(sline,sline,DataClass.drInteger.ToString,tab);
  113.     writestr(sline,sline,FormatFloat('0.00',DataClass.drFloat),tab);
  114.     writestr(sline,sline,DataClass.drCharArray,tab);
  115.     writestr(sline,sline,FormatDateTime('dd.mm.yyyy hh:nn:ss',DataClass.drDateTime),tab);
  116.     writestr(sline,sline,DataClass.drString);
  117.     writeln(sLine);
  118.   end;
  119.   writeLn('-----------------------------------------------------------');
  120. end;
  121.  
  122. begin
  123.   DataList:=TFPDataList.Create;
  124.   CreatedataList(4);
  125.  
  126.   DataList.CustomSort('drInteger',sdDescending,@DataListSortCompare);
  127.   ShowClassList('drInteger descend');
  128.  
  129.   DataList.CustomSort('drDateTime',sdAscending,@DataListSortCompare);
  130.   ShowClassList('drDateTime ascend');
  131.  
  132.   DataList.CustomSort('drInteger',sdAscending,@DataListSortCompare);
  133.   ShowClassList('drInteger ascend');
  134.  
  135.   DataList.Free;
  136. end.
  137.  

Can make SortDirection go away inside CustomQuickSort if want. No mind stupid choice for use FieldName string, is example.

MarkMLl

  • Hero Member
  • *****
  • Posts: 6676
Re: Sort Comparer function
« Reply #8 on: August 03, 2022, 10:47:23 pm »
The "least-work hack" way is probably to subclass TFPList to have an fSortBy field (an enumeration?), make each instance of TDataClass contain a reference to its parent list, and then have the comparer follow one of the pointers to determine which field should be used.

MarkMLl
MT+86 & Turbo Pascal v1 on CCP/M-86, multitasking with LAN & graphics in 128Kb.
Pet hate: people who boast about the size and sophistication of their computer.
GitHub repositories: https://github.com/MarkMLl?tab=repositories

Thausand

  • Sr. Member
  • ****
  • Posts: 292
Re: Sort Comparer function
« Reply #9 on: August 03, 2022, 11:28:53 pm »
I think helper is beter use:
Code: Pascal  [Select][+][-]
  1. program FPListHelpEx;
  2.  
  3. {$mode objfpc}{$H+}
  4. {$modeswitch typehelpers}
  5.  
  6. uses
  7.   classes,sysutils,dateutils;
  8.  
  9. type
  10.   TFPListCustomSortDirection=(sdAscending,sdDescending);
  11.   TFPListCustomSortCompareFunc=function(item1,item2:pointer;FieldName:string):integer;
  12.  
  13.   TFPListHelper=class helper for TFPList
  14.     procedure CustomSort(Compare:TFPListCustomSortCompareFunc; FieldName:string; SortDirection:TFPListCustomSortDirection = sdAscending);
  15.     procedure CustomQuickSort(FList:PPointerList;L,R:Longint;Compare:TFPListCustomSortCompareFunc;FieldName:string;SortDirection:TFPListCustomSortDirection);
  16.   end;
  17.  
  18. procedure TFPListHelper.CustomQuickSort(FList:PPointerList;L,R:Longint;Compare:TFPListCustomSortCompareFunc;FieldName:string;SortDirection:TFPListCustomSortDirection);
  19. var
  20.   I,J,P:Longint;
  21.   PItem,Q:Pointer;
  22. begin
  23.  repeat
  24.    I:=L;
  25.    J:=R;
  26.    P:=(L+R)div 2;
  27.    repeat
  28.      PItem:=FList^[P];
  29.      case SortDirection of
  30.        sdAscending:
  31.        begin
  32.          while Compare(PItem,FList^[i],FieldName)>0 do I:=I+1;
  33.          while Compare(PItem,FList^[J],FieldName)<0 do J:=J-1;
  34.        end;
  35.        sdDescending:
  36.        begin
  37.          while Compare(PItem,FList^[i],FieldName)<0 do I:=I+1;
  38.          while Compare(PItem,FList^[J],FieldName)>0 do J:=J-1;
  39.        end;
  40.      end;
  41.      if I<=J then
  42.      begin
  43.        Q:=FList^[I];
  44.        Flist^[I]:=FList^[J];
  45.        FList^[J]:=Q;
  46.        if P=I then
  47.         P:=J
  48.        else if P=J then
  49.         P:=I;
  50.        I:=I+1;
  51.        J:=J-1;
  52.      end;
  53.    until I>J;
  54.    if L<J then
  55.      CustomQuickSort(FList,L,J,Compare,FieldName,SortDirection);
  56.    L:=I;
  57.  until I>=R;
  58. end;
  59.  
  60. procedure TFPListHelper.CustomSort(Compare:TFPListCustomSortCompareFunc; FieldName:string; SortDirection:TFPListCustomSortDirection = sdAscending);
  61. begin
  62.   if not assigned(Self.List)or(Count<2) then exit;
  63.   CustomQuickSort(Self.List,0,Count-1,Compare,FieldName,SortDirection);
  64. end;
  65.  
  66.  
  67. const
  68.   tab=#09;
  69.  
  70. type
  71.   TDataClass=class
  72.     drInteger:integer;
  73.     drFloat:double;
  74.     drCharArray:array[0..400] of Char;
  75.     drDateTime:TDateTime;
  76.     drString:string[100];
  77.   end;
  78.  
  79. var
  80.   DataList:TFPList;
  81.   DataClass:TDataClass;
  82.  
  83. procedure CreateDataList(linecnt:integer);
  84. var
  85.   i:integer;
  86. begin
  87.   random;
  88.   for i:=1 to linecnt do
  89.   begin
  90.     DataClass:=TDataClass.Create;
  91.     DataClass.drInteger    := i;
  92.     DataClass.drFloat      := random(10000)*random();
  93.     //                         1...5...10...15...20...25...30...35...40...45...50
  94.     DataClass.drCharArray  := 'àààààààààààà '+i.ToString+' àààààààààààààbbbbb' +
  95.                               'éééééééééééé '+i.ToString+' éééééééééééééfffff';
  96.     DataClass.drDateTime   := IncMinute(Now+Random(60));
  97.     DataClass.drString     := 'We don''t use '+IntToStr(i)+' Tééést';
  98.     DataList.Add(DataClass);
  99.   end;
  100. end;
  101.  
  102. procedure ShowClassList(sTitle:string='');
  103. var
  104.   i:integer;
  105.   sline:string;
  106. begin
  107.   if sTitle<>'' then writeLn(sTitle+' : ');
  108.   for i:=0 to Pred(DataList.Count) do
  109.   begin
  110.     DataClass:=TDataClass(DataList[i]);
  111.     writestr(sline,'');
  112.     writestr(sline,sline,DataClass.drInteger.ToString,tab);
  113.     writestr(sline,sline,FormatFloat('0.00',DataClass.drFloat),tab);
  114.     writestr(sline,sline,DataClass.drCharArray,tab);
  115.     writestr(sline,sline,FormatDateTime('dd.mm.yyyy hh:nn:ss',DataClass.drDateTime),tab);
  116.     writestr(sline,sline,DataClass.drString);
  117.     writeln(sLine);
  118.   end;
  119.   writeLn('-----------------------------------------------------------');
  120. end;
  121.  
  122. function DataListSortCompare(item1,item2:pointer;FieldName:string):integer;
  123. begin
  124.   result:=0;
  125.   case FieldName of
  126.     'drInteger': result:=TDataClass(Item1).drInteger-TDataClass(Item2).drInteger;
  127.     'drDateTime':result:=CompareDateTime(TDataClass(item1).drDateTime,TDataClass(item2).drDateTime);
  128.   end;
  129. end;
  130.  
  131. begin
  132.   DataList:=TFPList.Create;
  133.   CreatedataList(4);
  134.  
  135.   DataList.CustomSort(@DataListSortCompare,'drInteger',sdDescending);
  136.   ShowClassList('drInteger descend');
  137.  
  138.   DataList.CustomSort(@DataListSortCompare,'drDateTime',sdAscending);
  139.   ShowClassList('drDateTime ascend');
  140.  
  141.   DataList.CustomSort(@DataListSortCompare,'drInteger');
  142.   ShowClassList('drInteger ascend');
  143.  
  144.   DataList.Free;
  145. end.
  146.  
Then can use for all TFPList.

jcmontherock

  • Full Member
  • ***
  • Posts: 234
Re: Sort Comparer function
« Reply #10 on: August 04, 2022, 03:09:31 pm »
Thanks everybody. I will explore all of your propositions.
Windows 11 UTF8-64 - Lazarus 3.2-64 - FPC 3.2.2

jcmontherock

  • Full Member
  • ***
  • Posts: 234
Re: Sort Comparer function
« Reply #11 on: August 05, 2022, 03:35:00 pm »
Thanks for your both code. There are very interesting.
I have one more question:  in procedure "CreateDataList" in both of your codes I get warning messages when I compile them:

"Warning: Implicit string type conversion from "AnsiString" to "UnicodeString"

Why should the value be converted to Unicode ?
After that I get:

"Warning: Implicit string type conversion with potential data loss from "UnicodeString" to "TDataClass.ShortString"

Are data in classes in Unicode encoded ?

PS: I should admit that I convert your code to utf-8 before compiling it.
Windows 11 UTF8-64 - Lazarus 3.2-64 - FPC 3.2.2

Thaddy

  • Hero Member
  • *****
  • Posts: 14210
  • Probably until I exterminate Putin.
Re: Sort Comparer function
« Reply #12 on: August 05, 2022, 04:15:46 pm »
Data in classes are encoded to your own specification.
UTF8 encoding is specified by Lazarus as UTF8, unless you explicitly declare the string type you expect. E.G. AnsiString or ShortString Or UnicodeString  or UTF8String.
FreePascal (the compiler) - so not Lazarus!!! - will natively encode in Ansi or Unicode16 depending on settings. Lazarus encodes UTF8 through its own system.
For both UTF8 and UTF16 four bytes need to be reserved per char.  Ansi requires just one byte, but the upper half of it depends on codepage.

I would also use a record instead of a class in your example.
Code: Pascal  [Select][+][-]
  1. TDataSomething = record  // may be packed record for storage purpose.....
  2.     drInteger:    Integer;
  3.     drFloat:      Double;
  4.     drCharArray:  Array[0..399] of AnsiChar; // Specify the correct char type. And count from zero: did you really mean 401?
  5.     drDateTime:   TDateTime;
  6.     drString:     String[100]; // this declaration makes it shortstring!!!! Other string types do not make sense.
  7.   end;
« Last Edit: August 05, 2022, 04:26:37 pm by Thaddy »
Specialize a type, not a var.

jcmontherock

  • Full Member
  • ***
  • Posts: 234
Re: Sort Comparer function
« Reply #13 on: August 05, 2022, 04:30:04 pm »
Record type is static data. So in my case I should use getmem for allocating or new/dispose It's more complicated.
Windows 11 UTF8-64 - Lazarus 3.2-64 - FPC 3.2.2

Thaddy

  • Hero Member
  • *****
  • Posts: 14210
  • Probably until I exterminate Putin.
Re: Sort Comparer function
« Reply #14 on: August 05, 2022, 06:32:14 pm »
Nope. Members of records are not static. The member and record member size are static.
Class is not needed here.
« Last Edit: August 05, 2022, 06:35:33 pm by Thaddy »
Specialize a type, not a var.

 

TinyPortal © 2005-2018