Lazarus

Programming => General => Topic started by: jcmontherock on August 02, 2022, 05:12:47 pm

Title: Sort Comparer function
Post by: jcmontherock 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

Title: Re: Sort Comparer function
Post by: Zvoni on August 03, 2022, 08:40:28 am
Use an Enum indicating the Field and a Boolean for Direction?
Title: Re: Sort Comparer function
Post by: MarkMLl 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
Title: Re: Sort Comparer function
Post by: jcmontherock 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.
Title: Re: Sort Comparer function
Post by: MarkMLl 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
Title: Re: Sort Comparer function
Post by: balazsszekely 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.
Title: Re: Sort Comparer function
Post by: MarkMLl 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
Title: Re: Sort Comparer function
Post by: Thausand 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.
Title: Re: Sort Comparer function
Post by: MarkMLl 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
Title: Re: Sort Comparer function
Post by: Thausand 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.
Title: Re: Sort Comparer function
Post by: jcmontherock on August 04, 2022, 03:09:31 pm
Thanks everybody. I will explore all of your propositions.
Title: Re: Sort Comparer function
Post by: jcmontherock 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.
Title: Re: Sort Comparer function
Post by: Thaddy 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;
Title: Re: Sort Comparer function
Post by: jcmontherock 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.
Title: Re: Sort Comparer function
Post by: Thaddy 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.
Title: Re: Sort Comparer function
Post by: jcmontherock on August 05, 2022, 09:26:54 pm
How do you pass to a new record without getmem/freemem or new/dispose and save address of each in a TList ?
Title: Re: Sort Comparer function
Post by: MarkMLl on August 05, 2022, 10:30:38 pm
Use a class instead of a record, create it (either with parameters defining the content or by setting them via properties) and then pass that to the list's add method.

MarkMLl
Title: Re: Sort Comparer function
Post by: Thausand on August 08, 2022, 07:58:46 pm
How do you pass to a new record without getmem/freemem or new/dispose and save address of each in a TList ?
I not sure if understand correct.

If want new record then getmem/new is need. No need getmem/new when use static record.

Code: Pascal  [Select][+][-]
  1. program static;
  2.  
  3. {$mode objfpc}
  4.  
  5. uses
  6.   classes,sysutils;
  7.  
  8. type
  9.   PStaticRecord=^TStaticRecord;
  10.   TStaticRecord=record
  11.     Field1:string;
  12.     Field2:integer;
  13.   end;
  14.  
  15. var
  16.   StaticRecordList:TList;
  17.   StaticRecords:array of TStaticRecord=
  18.   ((field1:'one';field2:1),
  19.    (field1:'two';field2:2),
  20.    (field1:'three';field2:3),
  21.    (field1:'four';field2:4),
  22.    (field1:'five';field2:5),
  23.    (field1:'six';field2:6),
  24.    (field1:'seven';field2:7),
  25.    (field1:'eight';field2:8),
  26.    (field1:'nine';field2:9),
  27.    (field1:'ten';field2:10));
  28.  
  29. function SortListCompare(item1,item2:pointer):integer;
  30. begin
  31.   result:=CompareText(PStaticRecord(item1)^.Field1,PStaticRecord(item2)^.Field1);
  32. end;
  33.  
  34. var
  35.   index:integer;
  36.   StaticRecord:PStaticRecord;
  37.  
  38. begin
  39.   StaticRecordList:=TList.Create;
  40.  
  41.   for index:=Low(StaticRecords) to High(StaticRecords)
  42.     // Addr = @
  43.     do StaticRecordList.Add(Addr(StaticRecords[index]));
  44.  
  45.   // write
  46.   writeln;
  47.   for StaticRecord in StaticRecordList
  48.     do Writeln(StaticRecord^.field1:6,' ',StaticRecord^.Field2:2);
  49.  
  50.   // sort
  51.   StaticRecordList.Sort(@SortListCompare);
  52.  
  53.   // write
  54.   writeln;
  55.   for StaticRecord in StaticRecordList
  56.     do Writeln(StaticRecord^.field1:6,' ',StaticRecord^.Field2:2);
  57.  
  58.   StaticRecordList.Free;
  59. end.
  60.  
TinyPortal © 2005-2018