Recent

Author Topic: Problem with TFPGObjectList  (Read 14788 times)

Thaddy

  • Hero Member
  • *****
  • Posts: 14205
  • Probably until I exterminate Putin.
Re: Problem with TFPGObjectList
« Reply #15 on: July 29, 2016, 10:16:05 am »
Here's a possible solution for OP given Molly's tip:
Code: Pascal  [Select][+][-]
  1. program project1;
  2. {$mode delphi}
  3. uses
  4.   fgl;
  5.  
  6. type
  7.   TItem = record
  8.     p:integer;
  9.     q:integer;
  10.     function SetItem(f2:integer;f3:integer):TItem;
  11.   end;
  12.    
  13.   TDictionary<TKey,TValue>  = class(TFPGMap<TKey,TValue>);
  14.  
  15.   function TItem.SetItem(f2:integer;f3:integer):Titem;
  16.   begin
  17.     p:=f2;
  18.     q:=f3;
  19.     Result := self;
  20.   end;
  21.    
  22.   procedure ShowObjectList(Z:TDictionary<string,Titem>);
  23.   var
  24.     k:integer;
  25.   begin
  26.     For k:= 0 to Z.count-1 do
  27.       writeln(Z.Keys[k] :6, Z.Data[k].p :4, Z.Data[k].q :4);
  28.     writeln;
  29.   end;
  30.  
  31. var
  32.   A:TDictionary<string,TItem>;
  33.   B:TItem;
  34. begin
  35.   A:=TDictionary<string,TItem>.Create;
  36.   try
  37.     A.Add('Lazarus',B.SetItem(28,7));
  38.     A.Add('Freepascal',B.SetItem(300,311));
  39.     ShowObjectList(A);
  40.     writeln(A.Count);
  41.   finally
  42.     A.free;
  43.   end;
  44.   writeln('---done----');
  45.   readln;
  46. end.
  47.  

Note I used a record instead of a class and a function - that returns self - instead of a procedure. That enables very powerful notation.
« Last Edit: July 29, 2016, 10:31:12 am by Thaddy »
Specialize a type, not a var.

HappyLarry

  • Full Member
  • ***
  • Posts: 155
Re: Problem with TFPGObjectList
« Reply #16 on: July 29, 2016, 02:07:16 pm »
Plenty to look at here!

When I posted this originally, I was trying to find a Free Pascal unit that offered me built-in data structures and methods to create an array of records (table), where I could add, amend and delete entries and (preferably) search on any field and sort on any field. This is a fairly common task.

@mollly I think you have shown that TFPGObjectList is not the way to go!
1. Sorting is good because the lis can be easily sorted by each field,
2. Search possibilities using IndexOf are not good without extra work such as the search function suggested by Thaddy.

I looked at StringLists with 'AddObject' but I have not managed to get that working.

@Thaddy Your code with TFPGMap instead was interesting. I used similar code with a simple record structure (not iDelphi mode so no Record + function) which resulted in less object-oriented code but still reasonably easy to use.
In this case
1. It was easy to sort the dictionary on the key field.
2. There were no methods to sort the dictionary on non-key fields. Although there is a compare function, the sort method doesn't allow it to be used.
3. Searching the key field is easy
4. Searching an individual  non-key fields is not possible. Searching for the whole TItem is possible.
Code: Pascal  [Select][+][-]
  1. {
  2. 1. You can search easily on the key,
  3. 2. You can search on the (whole) data for a key but not a single field
  4. 3. You can sort on the key
  5. 4. you can't sort on the data fields
  6. }
  7.  
  8. //The Dictionary is a List of entries
  9. //Each entry consists of Key + Item
  10.  
  11. program project1;
  12. uses
  13.   sysutils, fgl;
  14.  
  15. type
  16.     TItem = record
  17.       p:integer;
  18.       q:integer;
  19.     end;
  20.  
  21.     TDictionary = specialize TFPGMap<string, TItem>;
  22.  
  23. var
  24.   A:TDictionary;
  25.   B:TItem;
  26.   x:integer;
  27.  
  28. procedure ShowTitle(Message:string);
  29. begin
  30.      writeln;
  31.      writeln(Message);
  32.      writeln('---------------');
  33. end;
  34.  
  35. procedure SetItem(var Item:TItem; f2:integer;f3:integer);
  36. begin
  37.    With Item do
  38.    begin
  39.      p:=f2;
  40.      q:=f3;
  41.    end;
  42. end;
  43.  
  44. procedure ShowEntryFromKey(S:string; Z:TDictionary);
  45. begin
  46.    writeln(S:12, z.Data[Z.IndexOf(S)].p:4, z.Data[Z.IndexOf(S)].q:4);
  47. end;
  48.  
  49. procedure ShowEntryFromIndex(k:integer; Z:TDictionary);
  50. begin
  51.    writeln(z.Keys[k]:12, z.Data[k].p:4, Z.Data[k].q:4);
  52. end;
  53.  
  54. procedure ShowDictionary(Z:TDictionary);
  55. var
  56.   k:integer;
  57. begin
  58.    For k:= 0 to Z.count-1 do
  59.    begin
  60.       writeln(k:4, z.Keys[k]:12, z.Data[k].p:4, Z.Data[k].q:4);
  61.    end;
  62.    writeln;
  63. end;
  64.  
  65. begin
  66.   ShowTitle('TFPGObjectList');
  67.  
  68.   ShowTitle('Adding items');
  69.   A:=TDictionary.create;
  70.   SetItem(B,3,7);
  71.   A.Add('Lazarus', B);
  72.  
  73.   SetItem(B,8,5);
  74.   A.Add('Python',B);
  75.  
  76.   SetItem(B,3,10);
  77.   A.Add('Free Pascal',B);
  78.  
  79.   SetItem(B,5,11);
  80.   A.Add('Visual Basic',B);
  81.  
  82.   ShowTitle('List of itens');
  83.   ShowDictionary(A);
  84.  
  85.   A.Sort;
  86.   ShowTitle('Sorted list of items') ;
  87.   ShowDictionary(A);
  88.  
  89.   ShowTitle('Search for a key');
  90.   If A.Find('Lazarus',x) then
  91.   begin
  92.       ShowEntryFromKey('Lazarus',A);
  93.   end;
  94.  
  95.   ShowTitle('Search for an index');
  96.   ShowEntryFromIndex(2,A);
  97.  
  98.   ShowTitle('Search for a key (alternative)');
  99.   A.Find('Visual Basic',x);
  100.   ShowEntryFromIndex(x,A);
  101.  
  102.   ShowTitle('Search column 2 for 8,5');
  103.   SetItem(B,8,5);
  104.   ShowEntryFromIndex(A.IndexOfData(B), A);
  105.  
  106.   A.free;
  107.   writeln('---done----');
  108.   readln;
  109. end.

As you say,  GHashSet will concentrate on speedy searching rather than sorting.

The obvious possiblity would be TFPGList. This works well or a list of integers or strings (although the search is a linear search and quite slow for long lists). I tried using use it with records of several fields but I was unsuccessful.
I get the error
 Error: Operator is not overloaded: "TItem" = "TItem"
Here is my code.
Code: Pascal  [Select][+][-]
  1. program project1;
  2. uses
  3.   sysutils, fgl;
  4.  
  5. type
  6.     TItem = record
  7.       s:string;
  8.       p:integer;
  9.       q:integer;
  10.     end;
  11.  
  12.     TItemList = specialize TFPGList<TItem>;
  13.  
  14. var
  15.   A:TItemList;
  16.   B:TItem;
  17.  
  18.  
  19. begin
  20.    readln;
  21. end.

Any further observations or suggestions are welcome. Thanks to all contributors so far.
 
« Last Edit: July 29, 2016, 02:13:42 pm by HappyLarry »
Use Lazarus and Free Pascal and stand on the shoulders of giants . . . very generous giants. Thank you.

hnb

  • Sr. Member
  • ****
  • Posts: 270
Re: Problem with TFPGObjectList
« Reply #17 on: July 29, 2016, 02:34:53 pm »
...
 Error: Operator is not overloaded: "TItem" = "TItem"
...

To solve that you have 2 options:
  • override operator "=" (by class operator)
  • try to use more user friendly generic library: Generics.Collections (compatible with Delphi)


Checkout NewPascal initiative and donate beer - ready to use tuned FPC compiler + Lazarus for mORMot project

best regards,
Maciej Izak

Thaddy

  • Hero Member
  • *****
  • Posts: 14205
  • Probably until I exterminate Putin.
Re: Problem with TFPGObjectList
« Reply #18 on: July 29, 2016, 02:42:53 pm »
...
 Error: Operator is not overloaded: "TItem" = "TItem"
...

To solve that you have 2 options:
  • override operator "=" (by class operator)
  • try to use more user friendly generic library: Generics.Collections (compatible with Delphi)

The choice for naming the record Titem is unfortunate.
Specialize a type, not a var.

howardpc

  • Hero Member
  • *****
  • Posts: 4144
Re: Problem with TFPGObjectList
« Reply #19 on: July 29, 2016, 02:46:56 pm »
When I posted this originally, I was trying to find a Free Pascal unit that offered me built-in data structures and methods to create an array of records (table), where I could add, amend and delete entries and (preferably) search on any field and sort on any field. This is a fairly common task.

Obviously there is the db unit, and descendants of TDataset such as TBufDataset. Presumably you are looking for an object-oriented solution?

Thaddy

  • Hero Member
  • *****
  • Posts: 14205
  • Probably until I exterminate Putin.
Re: Problem with TFPGObjectList
« Reply #20 on: July 29, 2016, 03:04:37 pm »
 :-X If that is indeed the case I can recommend TBufDataset. It is like a pretty complete mini database. very well suited for single tables.

Here's a very simple example:
Code: Pascal  [Select][+][-]
  1. program bufdbtest;
  2. {$apptype console}{$mode objfpc}
  3. uses
  4.   db,BufDataset;
  5. var
  6.   BufDb:TBufDataset;
  7. begin
  8.  BufDb:=TBufDataset.Create(nil);
  9.  try
  10.    BufDb.FieldDefs.Add('NAME',ftString,20);
  11.    BufDb.FieldDefs.Add('NUM',ftinteger);
  12.    BufDb.FieldDefs.Add('NUM2',ftInteger);
  13.    BufDb.CreateDataSet;
  14.    BufDb.Open;
  15.    BufDb.Append;
  16.    BufDb.FieldByName('NAME').Value:='Free';
  17.    BufDb.Post;
  18.    BufDb.Append;
  19.    BufDb.FieldByName('NAME').Value:='Pascal';
  20.    BufDb.Post;
  21.    BufDb.SaveToFile('BufDb.txt');
  22.  finally
  23.    BufDb.Close;
  24.    BufDb.Free;
  25.  end;
  26.  // now, open..
  27.  BufDb := TBufDataset.Create(nil);
  28.  try
  29.    BufDb.LoadFromFile('BufDb.txt');
  30.    BufDb.Open;
  31.    BufDb.First;
  32.    Writeln(BufDb.FieldByName('NAME').Value);
  33.  finally
  34.    BufDb.Close;
  35.    BufDb.Free;
  36.  end;
  37.  
  38. end.
« Last Edit: July 29, 2016, 03:21:02 pm by Thaddy »
Specialize a type, not a var.

shobits1

  • Sr. Member
  • ****
  • Posts: 271
  • .
Re: Problem with TFPGObjectList
« Reply #21 on: July 29, 2016, 03:55:38 pm »
If that is indeed the case I can recommend TBufDataset. It is like a pretty complete mini database. very well suited for single tables.

Exactly my thoughts,, using TBufDataset will simplify things a lot,, but keep in mind there is no IndexOf function here (although you can add an the index as field), if you don't like Dataset approach you can use class helper like this:
Code: Pascal  [Select][+][-]
  1.    // Adding this to your code, will change the behavior of IndexOf function
  2.     TObjectListHelper = class helper for TObjectList
  3.       function IndexOf(AItem: TItem): Integer; overload;
  4.     end;
  5.  
  6.     function TObjectListHelper.IndexOf(AItem: TItem) : Integer; overload;
  7.     var
  8.       i: Integer;
  9.       item: TItem;
  10.     begin
  11.      result := -1;
  12.      for i := 0 to Pred(Self.Count) do
  13.      begin
  14.         item := Self[i];
  15.         if (item.p <> AItem.p) or (item.q <> AItem.q) then
  16.            Continue;
  17.  
  18.         // use CompareStr if you want case sensitivity
  19.         if CompareText(item.s, AItem.s)=0 then
  20.            Exit(i);
  21.      end;
  22.     end;
  23.  

HappyLarry

  • Full Member
  • ***
  • Posts: 155
Re: Problem with TFPGObjectList
« Reply #22 on: July 29, 2016, 04:01:58 pm »
@hnb
Quote
override operator "=" (by class operator)
How? Could you explain with some code?

@Thaddy
Quote
The choice for naming the record Titem is unfortunate.
I have tried other names but I get the same error.

@All Does anyone know if TFPGList will work with records (I know it works with simple datatypes like integer and string)?
« Last Edit: July 29, 2016, 04:08:05 pm by HappyLarry »
Use Lazarus and Free Pascal and stand on the shoulders of giants . . . very generous giants. Thank you.

Thaddy

  • Hero Member
  • *****
  • Posts: 14205
  • Probably until I exterminate Putin.
Re: Problem with TFPGObjectList
« Reply #23 on: July 29, 2016, 05:25:44 pm »
but keep in mind there is no IndexOf function here

No, but you have the much more powerful Locate and LookUp. No need for IndexOf, No need for record helpers. It is all there.
Specialize a type, not a var.

Thaddy

  • Hero Member
  • *****
  • Posts: 14205
  • Probably until I exterminate Putin.
Re: Problem with TFPGObjectList
« Reply #24 on: July 29, 2016, 05:32:50 pm »
   Does anyone know if TFPGList will work with records (I know it works with simple datatypes like integer and string)?

Unlike TFPGMap you will have to use Pointer to record and allocate them yourself, it seems, with  p:=New(TMyRecord) or something.
During my experiments I ran into that. Should be solvable.
Specialize a type, not a var.

shobits1

  • Sr. Member
  • ****
  • Posts: 271
  • .
Re: Problem with TFPGObjectList
« Reply #25 on: July 29, 2016, 05:56:17 pm »
but keep in mind there is no IndexOf function here (although you can add an the index as field)

No, but you have the much more powerful Locate and LookUp. No need for IndexOf, No need for record helpers. It is all there.
I know that, but maybe he needs the index for something else; and that's why I add he can use  an other field as index.

HappyLarry

  • Full Member
  • ***
  • Posts: 155
Re: Problem with TFPGObjectList
« Reply #26 on: July 29, 2016, 06:00:37 pm »
@shobits1 Nice code
Back to the original question about TFPGObject -
Shobit1's code means that IndexOf() behaves the way I would expect in TFPGObject. Now it is possible using TFPGObject to:
1. Sort by all three fields
2. Search for whole records
3. Search for just field 1
4. Search fields 2 and 3.

Of course, the helper function relies on having a (string,integer,integer)-type record so it is not really built-in . . .

Code: Pascal  [Select][+][-]
  1. program project1;
  2. uses
  3.   sysutils, fgl;
  4.  
  5. type
  6.     TItem = class
  7.       s:string;
  8.       p:integer;
  9.       q:integer;
  10.       procedure SetItem(f1:string;f2:integer;f3:integer);
  11.       procedure ShowItem;
  12.     end;
  13.  
  14.     TObjectList = specialize TFPGObjectList<TItem>;
  15.  
  16.     TObjectListHelper = class helper for TObjectList
  17.       function IndexOf(AItem: TItem): Integer; overload;
  18.       function IndexOf(AItem: string) : Integer; overload;
  19.       function IndexOf(AItem: integer) : Integer; overload;
  20.     end;
  21.  
  22.     procedure TItem.SetItem(f1:string;f2:integer;f3:integer);
  23.     begin
  24.        s:=f1;
  25.        p:=f2;
  26.        q:=f3;
  27.     end;
  28.  
  29.     procedure TItem.ShowItem;
  30.     begin
  31.        writeln(s:12,   p:4,  q:4);
  32.     end;
  33.  
  34.     function TObjectListHelper.IndexOf(AItem: TItem) : Integer; overload;
  35.     var
  36.       i: Integer;
  37.       item: TItem;
  38.     begin
  39.      result := -1;
  40.      for i := 0 to Pred(Self.Count) do
  41.      begin
  42.         item := Self[i];
  43.         if (item.p <> AItem.p) or (item.q <> AItem.q) then
  44.            Continue;
  45.  
  46.         // use CompareStr if you want case sensitivity
  47.         if CompareText(item.s, AItem.s)=0 then
  48.            Exit(i);
  49.      end;
  50.     end;
  51.  
  52.     function TObjectListHelper.IndexOf(AItem:string) : Integer; overload;
  53.     var
  54.       i: Integer;
  55.       item: TItem;
  56.     begin
  57.      result := -1;
  58.      for i := 0 to Pred(Self.Count) do
  59.      begin
  60.         item := Self[i];
  61.         if CompareText(item.s, AItem)=0 then
  62.         begin
  63.            Exit(i);
  64.         end;
  65.      end;
  66.     end;
  67.  
  68.     function TObjectListHelper.IndexOf(AItem: integer) : Integer; overload;
  69.     var
  70.       i: Integer;
  71.       item: TItem;
  72.     begin
  73.      result := -1;
  74.      for i := 0 to Pred(Self.Count) do
  75.      begin
  76.         item := Self[i];
  77.         if (item.p = AItem) or (item.q = AItem) then
  78.         begin
  79.            Exit(i);
  80.         end;
  81.      end;
  82.     end;
  83.  
  84.  
  85. var
  86.   A:TObjectList;
  87.   B:TItem;
  88.  
  89. procedure ShowTitle(Message:string);
  90. begin
  91.      writeln;
  92.      writeln(Message);
  93.      writeln('--------------------------');
  94. end;
  95.  
  96. procedure ShowObject(Z:TObjectList; k:integer);
  97. begin
  98.  
  99.    If k <> -1 then
  100.    begin
  101.         writeln(k:4,  Z[k].s:12,   Z[k].p:4, Z[k].q:4);
  102.    end;
  103. end;
  104.  
  105. procedure ShowObjectList(Z:TObjectList);
  106. var
  107.   k:integer;
  108. begin
  109.    For k:= 0 to Z.count-1 do
  110.    begin
  111.       writeln(k:4,  Z[k].s:12,   Z[k].p:4, Z[k].q:4);
  112.    end;
  113.    writeln;
  114. end;
  115.  
  116. function compare1(const a, b: TItem): Integer;
  117. begin
  118.   If a.s > b.s then
  119.      Result := 1;
  120.   If a.s = b.s then
  121.      Result := 0;
  122.   If a.s < b.s then
  123.      Result := -1;
  124. end;
  125.  
  126. function compare2(const a, b: TItem): Integer;
  127. begin
  128.   Result := a.p - b.p;
  129. end;
  130.  
  131. function compare3(const a, b: TItem): Integer;
  132. begin
  133.   Result := a.q - b.q;
  134. end;
  135.  
  136.  
  137. begin
  138.   ShowTitle('TFPGObjectList');
  139.  
  140.   A:=TObjectList.create;
  141.   A.FreeObjects:=False;
  142.  
  143.   ShowTitle('Adding objects');
  144.  
  145.   B:=TItem.create;
  146.   B.SetItem('Lazarus',3,7);
  147.   A.Add(B);
  148.  
  149.   B:=TItem.create;
  150.   B.SetItem('Python',8,5);
  151.   A.Add(B);
  152.  
  153.   B:=TItem.create;
  154.   B.SetItem('Free Pascal',3,10);
  155.   A.Add(B);
  156.  
  157.   B:=TItem.create;
  158.   B.SetItem('Visual Basic',5,11);
  159.   A.Add(B);
  160.   writeln('Index of B is ',A.IndexOf(B));
  161.  
  162.   ShowTitle('Sort by column 1');
  163.   A.Sort(@Compare1);
  164.   ShowObjectList(A);
  165.   writeln(A.Count);
  166.  
  167.   ShowTitle('Sort by column 2');
  168.   A.Sort(@Compare2);
  169.   ShowObjectList(A);
  170.   writeln(A.Count);
  171.  
  172.   ShowTitle('Sort by column 3');
  173.   A.Sort(@Compare3);
  174.   ShowObjectList(A);
  175.   writeln(A.Count);
  176.  
  177.   ShowTitle('Find the index given a complete item');
  178.   B:=TItem.create;
  179.   B.SetItem('Lazarus',3,7);
  180.   writeln('Index of Lazarus is : ',A.IndexOf(B));
  181.   ShowObject(A, A.IndexOf(B));
  182.  
  183.   ShowTitle('Find the index given the key value string');
  184.   writeln('Index of Free Pascal is : ',A.IndexOf('Free Pascal'));
  185.   ShowObject(A, A.IndexOf('Free Pascal'));
  186.  
  187.   ShowTitle('Find the index given a non-key value 10');
  188.   writeln('Index of 10 is : ',A.IndexOf(10));
  189.   ShowObject(A, A.IndexOf(10));
  190.  
  191.   ShowTitle('Find the index given a non-key value 3');
  192.   writeln('Index of 3 is : ',A.IndexOf(3));
  193.   ShowObject(A, A.IndexOf(3));
  194.  
  195.   B.free;
  196.   A.free;
  197.  
  198.   writeln('---done----');
  199.   readln;
  200. end.
« Last Edit: July 29, 2016, 06:03:27 pm by HappyLarry »
Use Lazarus and Free Pascal and stand on the shoulders of giants . . . very generous giants. Thank you.

Thaddy

  • Hero Member
  • *****
  • Posts: 14205
  • Probably until I exterminate Putin.
Re: Problem with TFPGObjectList
« Reply #27 on: July 29, 2016, 06:20:14 pm »
@All, Molly ;) We now have TDictionary! in trunk...

I referred to Sparta generic library.
As of today that is also in trunk and called rtl-generics.
It is a bit more powerful than what we had in many ways.
If you build trunk from this afternoon, you will see it appear,

It is Delphi compatible. Here's an example along the lines of this discussion.
This code needs trunk 34299 or higher because in that revision rtl-generics is added.
Code: Pascal  [Select][+][-]
  1. program project1;
  2. {$mode delphi}
  3. uses
  4.   generics.collections;
  5.  
  6. type
  7.   TItem = record
  8.     p:integer;
  9.     q:integer;
  10.     function SetItem(f2:integer;f3:integer):TItem;
  11.   end;
  12.  
  13.   function TItem.SetItem(f2:integer;f3:integer):Titem;
  14.   begin
  15.     p:=f2;
  16.     q:=f3;
  17.     Result := self;
  18.   end;
  19.    
  20.   procedure ShowObjectList(Z:TDictionary<string,Titem>);
  21.   var
  22.     Item:Titem;
  23.     s:string;
  24.   begin
  25.     For s in Z.keys do
  26.       if Z.TryGetValue(S,Item) then
  27.         writeln('value''s for ',S,': ', Item.p :6, Item.q :6);
  28.   end;
  29.  
  30. var
  31.   A:TDictionary<string,TItem>;
  32.   B:TItem;
  33. begin
  34.   A:=TDictionary<string,TItem>.Create;
  35.   try
  36.     A.Add('Lazarus',B.SetItem(28,7));
  37.     A.Add('Test',B.SetItem(7,28));
  38.     A.Add('Freepascal',B.SetItem(300,311));
  39.     ShowObjectList(A);
  40.     writeln('Count is:',A.Count);
  41.     writeln('If Test does exist change values else add Test');
  42.     A.AddOrSetValue('Test',B.SetItem(3000,3000));
  43.     writeln('If blaat does not exist add it, else change the values');
  44.     A.AddOrSetValue('Blaat',B.SetItem(0,0));
  45.     writeln('Count is:',A.Count);    
  46.     ShowObjectList(A);
  47.     writeln('remove an element');
  48.     A.Remove('Test');
  49.     writeln('Count is:',A.Count);
  50.     ShowObjectList(A);
  51.   finally
  52.     A.free;
  53.   end;
  54.   readln;
  55. end.
  56.  

btw:
I tested delphi compatibilty with http://docwiki.embarcadero.com/CodeExamples/Seattle/en/Generics_Collections_TDictionary_(Delphi)#Uses
Note the uses clause for the code is missing but it is: uses sysutils,math, generics.collections.
« Last Edit: July 30, 2016, 10:19:23 am by Thaddy »
Specialize a type, not a var.

 

TinyPortal © 2005-2018