Generic array of records with sorting and such?

[domasz]

Is there a generic that can be an array of record but with sorting by data?

I tried:

Code: Pascal  [Select][+][-]

1. TMyFiles = specialize TFPGMap<Integer, TMyFileRec>;

but it can only sort by key (Integer) using whatever I hook to OnKeyCompare.

[Thaddy]

generics.collections can do that

[paweld]

https://forum.lazarus.freepascal.org/index.php/topic,59213.msg441533.html#msg441533

[domasz]

Thank you!

I didn't find anything that would work exactly like I wanted so I made my own.
Usage example:

Code: Pascal  [Select][+][-]

1.   TRec = record
2.     Name: String;
3.     Surname: String;
4.   end;
5.  
6.   TArr = specialize TSortable<TRec>;
7.  
8. ...
9. function CompareFun(const Data1, Data2: TRec): Integer;
10. begin
11.   Result := AnsiCompareStr(Data1.Name, Data2.Name);
12. end;    
13.  
14. var Arr: TArr;
15.     Rec: TRec;
16.     i: Integer;
17.     Idx: Integer;
18. begin
19.   Arr := TArr.Create;
20.  
21.   Rec.Name := 'John';
22.   Rec.Surname := 'Kowalski';
23.  
24.   Arr.Add(Rec);
25.  
26.   Rec.Name := 'Adam';
27.   Rec.Surname := 'Smith';
28.  
29.   Arr.Add(Rec);
30.  
31.   Arr.Sort(@CompareFun);
32.  
33.   for i:=0 to Arr.Count-1 do
34.     Memo1.Lines.Add(Arr[i].Name + ' ' + Arr[i].Surname);
35.  
36.   Rec.Name := 'Adama';
37.   Rec.Surname := 'Worcestershire';
38.  
39.   Idx := Arr.IndexOf(Rec, @CompareFun);
40.  
41.   Memo1.Lines.Add(IntToStr(Idx));
42.  
43.   Arr.Free;                                            
44.  

Code: [Select]

unit Sortable;

{$mode objfpc}{$H+}

interface

//Sortable- a nice array for records by domasz

uses
  Classes, SysUtils, StdCtrls, FGL, Types, Dialogs, Generics.Collections, Generics.Defaults;

type

  { TSortable }

  generic TSortable<TData> = class
  private
    type TCompareFun = function(const Data1, Data2: TData): Integer;
  private
    FItems: array of TData;
    FMaxSize: Integer;
    FSize: Integer;
    FSorted: Boolean;
    procedure SetItem(Index: Integer; Value: TData);
    function GetItem(Index: Integer): TData;
    procedure Grow;
    function BinSearch(Data: TData; CompareFun: TCompareFun): Integer;
  public
    constructor Create;
    property Count: Integer read FSize;
    property Items[Index: Integer]: TData read GetItem write SetItem; default;
    procedure Add(Value: TData);
    procedure Delete(Index: Integer);
    procedure Sort(CompareFun: TCompareFun);
    procedure Clear;
    function IndexOf(Data: TData; CompareFun: TCompareFun): Integer;
    procedure Optimize;
  end;

implementation

{ TSortable }

procedure TSortable.SetItem(Index: Integer; Value: TData);
begin
  if (Index<0) or (Index>FSize-1) then Exception.Create('Index out of bounds');

  FItems[Index] := Value;
end;

function TSortable.GetItem(Index: Integer): TData;
begin
  if (Index<0) or (Index>FSize-1) then Exception.Create('Index out of bounds');

  Result := FItems[Index];
end;

procedure TSortable.Grow;
begin
  Inc(FMaxSize, 100);
  SetLength(FItems, FMaxSize);
end;

function TSortable.BinSearch(Data: TData; CompareFun: TCompareFun): Integer;
var Left, Right: Integer;
    Cur: TData;
    i: Integer;
    Found: Boolean;
    SameRes: Integer;
begin
  Found := false;
  Result := -1;
  if FSize = 0 then Exit;

  Left := 0;
  Right := FSize-1;

  while ((CompareFun(FItems[Left], FItems[Right]) <= 0) and (Found = false)) do begin
    i := Left + ((Right - Left) div 2);
    Cur := FItems[i];

    SameRes := CompareFun(Data, Cur);

    if SameRes = 0 then begin
      Result := i;
      Found := True;
    end
    else if SameRes > 0 then Left := i + 1
    else Right := i - 1;
  end;
end;

constructor TSortable.Create;
begin
  inherited Create;
  FMaxSize := 100;
  FSize := 0;
  FSorted := True;
  SetLength(FItems, FMaxSize);
end;

procedure TSortable.Add(Value: TData);
begin
  if FSize = FMaxSize then Grow;

  FItems[FSize] := Value;
  Inc(FSize);
  FSorted := False;
end;

procedure TSortable.Delete(Index: Integer);
var i: Integer;
begin
  if (Index<0) or (Index>FSize-1) then Exception.Create('Index out of bounds');

  for i:=Index to FSize-3 do
    FItems[i] := FItems[i+1];

  Dec(FSize);
end;

procedure TSortable.Sort(CompareFun: TCompareFun);
  procedure QSort(ALo, AHi: Integer);
  var Lo, Hi: Integer;
      Pivot, Temp: TData;
  begin
    Lo := ALo;
    Hi := AHi;
    Pivot := FItems[(Lo + Hi) div 2];
    repeat
      while CompareFun(FItems[Lo], Pivot) < 0 do Inc(Lo);
      while CompareFun(FItems[Hi], Pivot) > 0 do Dec(Hi);

      if Lo <= Hi then begin
        Temp := FItems[Lo];
        FItems[Lo] := FItems[Hi];
        FItems[Hi] := Temp;
        Inc(Lo) ;
        Dec(Hi) ;
      end;
    until Lo > Hi;
    if Hi > ALo then QSort(ALo, Hi) ;
    if Lo < AHi then QSort(Lo, AHi) ;
  end;

begin
  QSort(0, FSize-1);
  FSorted := True;
end;

procedure TSortable.Clear;
begin
  FSize := 0;
end;

function TSortable.IndexOf(Data: TData; CompareFun: TCompareFun): Integer;
var i: Integer;
begin
  if FSorted then begin
    Result := BinSearch(Data, CompareFun);
    Exit;
  end;

  Result := -1;

  for i:=0 to FSize-1 do
    if CompareFun(FItems[i], Data) = 0 then begin
      Result := i;
      Exit;
    end;
end;

procedure TSortable.Optimize;
begin
  FMaxSize := FSize;
  SetLength(FItems, FSize);
end;

end.


[Warfley]

Have you tried gmap or gset: https://wiki.freepascal.org/GSet

[domasz]

I don't think I can quickly access n-th element using TSet.

[ASerge]

Is there a generic that can be an array of record but with sorting by data?

Code: Pascal  [Select][+][-]

1. {$MODE OBJFPC}
2. {$APPTYPE CONSOLE}
3. {$LONGSTRINGS ON}
4. {$MODESWITCH ADVANCEDRECORDS}
5.  
6. uses SysUtils, Generics.Defaults, Generics.Collections;
7.  
8. type
9.   TRec = record
10.     Name: string;
11.     Surname: string;
12.     constructor Create(const AName, ASurname: string);
13.   end;
14.  
15.   TList = specialize TSortedList<TRec>;
16.  
17. constructor TRec.Create(const AName, ASurname: string);
18. begin
19.   Name := AName;
20.   Surname := ASurname;
21. end;
22.  
23. function CompareRec(constref R1, R2: TRec): Integer;
24. begin
25.   Result := AnsiCompareText(R1.Name, R2.Name);
26.   if Result = 0 then
27.     Result := AnsiCompareText(R1.Surname, R2.Surname);
28. end;
29.  
30. var
31.   List: TList;
32.   R: TRec;
33. begin
34.   List := TList.Create((specialize TComparer<TRec>).Construct(@CompareRec));
35.   try
36.     List.Add(TRec.Create('John', 'Kowalski'));
37.     List.Add(TRec.Create('Adam', 'Smith'));
38.     List.Add(TRec.Create('Bill', 'Smith'));
39.     for R in List do
40.       Writeln('Name: ', R.Name, ', Surname: ', R.Surname);
41.   finally
42.     List.Free;
43.   end;
44.   Readln;
45. end.

[marcov]

Generics.collections.TarrayHelper.sort<>

[rforcen]

generics.collections can do that

any snippet available?

[Thaddy]

Well, what's wrong with your eyes? And mine..
Domasz (and ASerge) have given you pretty good examples.
It is not for me to add more to your confusion.
Take the code by Domasz as a basis.

[rforcen]

thankx for replying, issue solved in open post