search in TFPGObjectlist

[JohnKuiper]

is it possible to use a kind of binarysearch in TFPGObjectlist to search an item quickly?
Now I'm using the traditional way:

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

1. procedure TKeurmeesterUitslag.GetKeurmeesters;
2. var
3.   Row             : TKMUitslag;
4.   KeurmeesterItem : TKeurmeester;
5. begin
6.   fKeurmeester.Clear;
7.   for Row in fLijst do
8.   begin
9.     if not LocateKeurmeester(row.keurmeester_id) then
10.     begin
11.       KeurmeesterItem      := TKeurmeester.create;
12.       KeurmeesterItem.id   := row.keurmeester_id;
13.       KeurmeesterItem.naam := row.keurmeester;
14.       fKeurmeesterlijst.Add(keurmeesterItem);
15.     end;
16.   end;
17. end;
18.  
19. function TKeurmeesterUitslag.LocateKeurmeester(const aID : integer) : boolean;
20. var
21.   row : TKeurmeester;
22. begin
23.   result := false;
24.   for row in fKeurmeesterlijst do
25.   begin
26.     if row.id = aID then
27.     begin
28.       result := true;
29.       break;
30.     end;
31.   end;
32. end;
33.  

fKeurmeesterlijst is typed as class(specialize TFPGObjectlist<TKeurmeester>);

[Bart]

Doesn't TFPGObjectlist have an IndoxOf() function?

Bart

[paweld]

""for to do"" loop is about 30% faster than "for in" loop

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

1. program Project1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. uses
6.   Classes, SysUtils, fgl, DateUtils;
7.  
8. type
9.   TKeurmeester = class
10.     id: Integer;
11.     naam: String;
12.   end;
13.  
14.   { TKeurmeesterList }
15.  
16.   TKeurmeesterList = class(specialize TFPGObjectList<TKeurmeester>)
17.   public
18.     function LocateKeurmeester(id: Integer):  Boolean;
19.     function LocateKeurmeesterIn(id: Integer): Boolean;
20.   end;
21.  
22. { TKeurmeesterList }
23.  
24. function TKeurmeesterList.LocateKeurmeester(id: Integer): Boolean;
25. var
26.   i: Integer;
27. begin
28.   Result := False;
29.   for i := 0 to Count - 1 do
30.   begin
31.     if Items[i].id = id then
32.     begin
33.       Result := True;
34.       break;
35.     end;
36.   end;
37. end;
38.  
39. function TKeurmeesterList.LocateKeurmeesterIn(id: Integer): Boolean;
40. var
41.   ki: TKeurmeester;
42. begin
43.   Result := False;
44.   for ki in Self do
45.   begin
46.     if ki.id = id then
47.     begin
48.       Result := True;
49.       break;
50.     end;
51.   end;
52. end;
53.  
54. var
55.   kl: TKeurmeesterList;
56.   ki: TKeurmeester;
57.   i, n: Integer;
58.   dt: TDateTime;
59. begin
60.   Randomize;
61.   n := 10000;
62.   //create list with data
63.   kl := TKeurmeesterList.Create;
64.   for i := 0 to 999999 do
65.   begin
66.     ki := TKeurmeester.Create;
67.     ki.id := Random(999999999);
68.     ki.naam := 'Item ' + IntToStr(ki.id);
69.     kl.Add(ki);
70.   end;
71.   //"for in" test
72.   dt := Now;
73.   for i := 0 to n do
74.     kl.LocateKeurmeesterIn(34533);
75.   WriteLn('"for in" loop time in ms: ', MillisecondsBetween(Now, dt));
76.   //"for to do" test
77.   dt := Now;
78.   for i := 0 to n do
79.     kl.LocateKeurmeester(34533);
80.   WriteLn('"for to do" loop time in ms: ', MillisecondsBetween(Now, dt));
81.   kl.Free;
82.   ReadLn;
83. end.
84.  

Results:

Code: [Select]

"for in" loop time in ms: 30162
"for to do" loop time in ms: 21754


[JohnKuiper]

@bart

As far as I noticed indexof is pointer refferenced of the item and not the value of the item. T tried this:

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

1. object := TMyobject.create;
2. object.id := 22;
3. object.name := 'a Name';
4. if Mylist.indexof(object) = -1 then
5.   Mylist.add(object)
6. else
7.   object.free;
8.  

If I do this 5 times al items are added but should be one.

@paweld
Yes I know with for ... in ... each time a item will be copied. Lets say it is my Delphi kind of thing.

[wp]

IndexOf does a linear search, though, rather than a binary search.

[Thaddy]

except if the list is sorted?

[wp]

Nothing "sorted" in here:

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

1. function TFPList.IndexOf(Item: Pointer): Integer;
2. Var
3.   C : Integer;
4. begin
5.   Result:=0;
6.   C:=Count;
7.   while (Result<C) and (Flist^[Result]<>Item) do
8.     Inc(Result);
9.   If Result>=C then
10.     Result:=-1;
11. end;

[Thaddy]

Well, then that should be fixed...

[paweld]

you can create a map of id's, then looks very good:

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

1. program Project1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. uses
6.   Classes, SysUtils, fgl, DateUtils, StrUtils;
7.  
8. type
9.   TKeurmeester = class
10.     id: Integer;
11.     naam: String;
12.   end;
13.  
14.   { TKeurmeesterList }
15.  
16.   TKeurmeesterList = class(specialize TFPGObjectList<TKeurmeester>)
17.   type
18.     TIDMap = specialize TFPGMap<Integer, Integer>;
19.   private
20.     fIDMap: TIDMap;
21.   public
22.     constructor Create;
23.     destructor Destroy; override;
24.     function Add(aItem: TKeurmeester): Integer;
25.     procedure Delete(aIndex: Integer);
26.     function LocateKeurmeester(id: Integer):  Boolean;
27.     function LocateKeurmeesterIn(id: Integer): Boolean;
28.     function LocateKeurmeesterMap(id: Integer):  Boolean;
29.     procedure BeginUpdate;
30.     procedure EndUpdate;
31.   end;
32.  
33. { TKeurmeesterList }
34.  
35. constructor TKeurmeesterList.Create;
36. begin
37.   inherited Create;
38.   fIDMap := TIDMap.Create;
39.   fIDMap.Duplicates := dupIgnore;
40.   fIDMap.Sorted := True;
41. end;
42.  
43. destructor TKeurmeesterList.Destroy;
44. begin
45.   fIDMap.Free;
46.   inherited Destroy;
47. end;
48.  
49. function TKeurmeesterList.Add(aItem: TKeurmeester): Integer;
50. begin
51.   Result := inherited Add(aItem);
52.   fIDMap.Add(aItem.id, Result);
53. end;
54.  
55. procedure TKeurmeesterList.Delete(aIndex: Integer);
56. var
57.   idx: Integer;
58. begin
59.   idx := fIDMap.IndexOf(Items[aIndex].id);
60.   if idx >= 0 then
61.     fIDMap.Delete(idx);
62.   inherited Delete(aIndex);
63. end;
64.  
65. function TKeurmeesterList.LocateKeurmeester(id: Integer): Boolean;
66. var
67.   i: Integer;
68. begin
69.   Result := False;
70.   for i := 0 to Count - 1 do
71.   begin
72.     if Items[i].id = id then
73.     begin
74.       Result := True;
75.       break;
76.     end;
77.   end;
78. end;
79.  
80. function TKeurmeesterList.LocateKeurmeesterIn(id: Integer): Boolean;
81. var
82.   ki: TKeurmeester;
83. begin
84.   Result := False;
85.   for ki in Self do
86.   begin
87.     if ki.id = id then
88.     begin
89.       Result := True;
90.       break;
91.     end;
92.   end;
93. end;
94.  
95. function TKeurmeesterList.LocateKeurmeesterMap(id: Integer): Boolean;
96. begin
97.   Result := fIDMap.IndexOf(id) >= 0;
98. end;
99.  
100. procedure TKeurmeesterList.BeginUpdate;
101. begin
102.   fIDMap.Sorted := False;
103. end;
104.  
105. procedure TKeurmeesterList.EndUpdate;
106. begin
107.   fIDMap.Sort;
108.   fIDMap.Sorted := True;
109. end;
110.  
111. var
112.   kl: TKeurmeesterList;
113.   ki: TKeurmeester;
114.   i, j, n, v: Integer;
115.   valarr: Array [1..4] of Integer = (5378, 478315, 999998, 9999999);
116.   dt: TDateTime;
117. begin
118.   n := 100000;
119.   dt := Now;
120.   //create list with data
121.   kl := TKeurmeesterList.Create;
122.   kl.BeginUpdate;
123.   for i := 0 to 999999 do
124.   begin
125.     ki := TKeurmeester.Create;
126.     ki.id := i;
127.     ki.naam := 'Item ' + IntToStr(i);
128.     kl.Add(ki);
129.   end;
130.   kl.EndUpdate;
131.   WriteLn('prepare data: ', MillisecondsBetween(Now, dt));
132.   for j := Low(valarr) to High(valarr) do
133.   begin
134.     WriteLn('==========================');
135.     WriteLn('Check ID: ', valarr[j], ' loop count: ', n div StrToInt(Copy('1000', 1, j)));
136.     WriteLn('--------------------------');
137.     //"for in" test
138.     dt := Now;
139.     for i := 0 to n div StrToInt(Copy('1000', 1, j)) do
140.       kl.LocateKeurmeesterIn(valarr[j]);
141.     WriteLn('"for in" loop time in ms: ', MillisecondsBetween(Now, dt), '; result: ', IfThen(kl.LocateKeurmeesterIn(valarr[j]), 'True', 'False'));
142.     //"for to do" test
143.     dt := Now;
144.     for i := 0 to n div StrToInt(Copy('1000', 1, j)) do
145.       kl.LocateKeurmeester(valarr[j]);
146.     WriteLn('"for to do" loop time in ms: ', MillisecondsBetween(Now, dt), '; result: ', IfThen(kl.LocateKeurmeester(valarr[j]), 'True', 'False'));
147.     //map test
148.     dt := Now;
149.     for i := 0 to n div StrToInt(Copy('1000', 1, j)) do
150.       kl.LocateKeurmeesterMap(valarr[j]);
151.     WriteLn('map time in ms: ', MillisecondsBetween(Now, dt), '; result: ', IfThen(kl.LocateKeurmeesterMap(valarr[j]), 'True', 'False'));
152.   end;
153.   kl.Free;
154.   ReadLn;
155. end.

results:

Code: [Select]

prepare data: 250
==========================
Check ID: 5378 loop count: 100000
--------------------------
"for in" loop time in ms: 3031; result: True
"for to do" loop time in ms: 2157; result: True
map time in ms: 16; result: True
==========================
Check ID: 478315 loop count: 10000
--------------------------
"for in" loop time in ms: 26877; result: True
"for to do" loop time in ms: 19596; result: True
map time in ms: 0; result: True
==========================
Check ID: 999998 loop count: 1000
--------------------------
"for in" loop time in ms: 5673; result: True
"for to do" loop time in ms: 4078; result: True
map time in ms: 0; result: True
==========================
Check ID: 9999999 loop count: 100
--------------------------
"for in" loop time in ms: 563; result: False
"for to do" loop time in ms: 421; result: False
map time in ms: 0; result: False



[jamie]

Please try to use a Different name other than "Object" that is a reserved word and shows it here in the forums.

I am surprised you didn't have other code issues with that.

[jamie]

Doesn't TFPGObjectlist have an IndoxOf() function?

Bart

It does however, it does not have a IndexOf() function with an starting index option so that you can find the first and then find the next and so on.

Indexof(TheItem, StartIndex = 0);

etc.

 Maybe a consideration should be in place for that?

[silvercoder70]

Things like binary searches would only work in cases where the list is sorted, hence the way that indexof is implemented. It could only do something else if it knows the list was sorted. And without know what or how much you need to store you could consider either a dictionary, map or some other structure for faster searching?

[BrunoK]

Things like binary searches would only work in cases where the list is sorted, hence the way that indexof is implemented. It could only do something else if it knows the list was sorted. And without know what or how much you need to store you could consider either a dictionary, map or some other structure for faster searching?

If you need good add/delete/locate functionality in changing lists, you should study the use of an AVL tree.
FPC has a very well functioning one in unit :

\fpc\packages\fcl-base\src\avl_tree.pp

Using an AVL tree allows insertion / deletion / retrieval in N(Log(n)) times (if right, anyway very fast for out of order additions/deletions). It already beats a ordered list from ~32 items in the list.

[paweld]

@BrunoK: Thanks for the hint, I've never used AVL Tree before, and it's faster than FGL (at least with this solution)

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

1. program Project1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. uses
6.   Classes, SysUtils, fgl, DateUtils, StrUtils, avl_tree;
7.  
8. type
9.   TKeurmeester = class
10.     id: Integer;
11.     naam: String;
12.   end;
13.  
14.   { TKeurmeesterList }
15.  
16.   TKeurmeesterList = class(specialize TFPGObjectList<TKeurmeester>)
17.   type
18.     TIDMap = specialize TFPGMap<Integer, Integer>;
19.   private
20.     fIDMap: TIDMap;
21.   public
22.     constructor Create;
23.     destructor Destroy; override;
24.     function Add(aItem: TKeurmeester): Integer;
25.     procedure Delete(aIndex: Integer);
26.     function LocateKeurmeesterMap(id: Integer):  Boolean;
27.     procedure BeginUpdate;
28.     procedure EndUpdate;
29.   end;
30.  
31. { TKeurmeesterList }
32.  
33. constructor TKeurmeesterList.Create;
34. begin
35.   inherited Create;
36.   fIDMap := TIDMap.Create;
37.   fIDMap.Duplicates := dupIgnore;
38.   fIDMap.Sorted := True;
39. end;
40.  
41. destructor TKeurmeesterList.Destroy;
42. begin
43.   fIDMap.Free;
44.   inherited Destroy;
45. end;
46.  
47. function TKeurmeesterList.Add(aItem: TKeurmeester): Integer;
48. begin
49.   Result := inherited Add(aItem);
50.   fIDMap.Add(aItem.id, Result);
51. end;
52.  
53. procedure TKeurmeesterList.Delete(aIndex: Integer);
54. var
55.   idx: Integer;
56. begin
57.   idx := fIDMap.IndexOf(Items[aIndex].id);
58.   if idx >= 0 then
59.     fIDMap.Delete(idx);
60.   inherited Delete(aIndex);
61. end;
62.  
63. function TKeurmeesterList.LocateKeurmeesterMap(id: Integer): Boolean;
64. begin
65.   Result := fIDMap.IndexOf(id) >= 0;
66. end;
67.  
68. procedure TKeurmeesterList.BeginUpdate;
69. begin
70.   fIDMap.Sorted := False;
71. end;
72.  
73. procedure TKeurmeesterList.EndUpdate;
74. begin
75.   fIDMap.Sort;
76.   fIDMap.Sorted := True;
77. end;
78.  
79. function CompareAVL(Data1, Data2: Pointer): Integer;
80. begin
81.   Result := TKeurmeester(Data1).id - TKeurmeester(Data2).id;
82. end;
83.  
84. var
85.   kl: TKeurmeesterList;
86.   ki: TKeurmeester;
87.   i, j, n, v: Integer;
88.   valarr: Array [1..4] of Integer = (5378, 478315, 999998, 99999999);
89.   dt: TDateTime;
90.   tree: TAVLTree;
91. begin
92.   n := 10000000;
93.   //FGL
94.   //create list with data
95.   dt := Now;
96.   kl := TKeurmeesterList.Create;
97.   kl.BeginUpdate;
98.   for i := 0 to 9999999 do
99.   begin
100.     ki := TKeurmeester.Create;
101.     ki.id := i;
102.     ki.naam := 'Item ' + IntToStr(i);
103.     kl.Add(ki);
104.   end;
105.   kl.EndUpdate;
106.   WriteLn('FGL prepare data: ', MillisecondsBetween(Now, dt));
107.   for j := Low(valarr) to High(valarr) do
108.   begin
109.     WriteLn('==========================');
110.     WriteLn('Check ID: ', valarr[j], ' loop count: ', n);
111.     WriteLn('--------------------------');
112.     //map test
113.     dt := Now;
114.     for i := 0 to n do
115.       kl.LocateKeurmeesterMap(valarr[j]);
116.     WriteLn('map time in ms: ', MillisecondsBetween(Now, dt), '; result: ', IfThen(kl.LocateKeurmeesterMap(valarr[j]), 'True', 'False'));
117.   end;
118.   kl.Free;
119.   //AVL
120.   //create tree with data
121.   dt := Now;
122.   tree := TAVLTree.Create(@CompareAVL);
123.   for i := 0 to 9999999 do
124.   begin
125.     ki := TKeurmeester.Create;
126.     ki.id := i;
127.     ki.naam := 'Item ' + IntToStr(i);
128.     tree.Add(ki);
129.   end;
130.   WriteLn('AVL prepare data: ', MillisecondsBetween(Now, dt));
131.   for j := Low(valarr) to High(valarr) do
132.   begin
133.     WriteLn('==========================');
134.     WriteLn('Check ID: ', valarr[j], ' loop count: ', n);
135.     WriteLn('--------------------------');
136.     //avl test
137.     dt := Now;
138.     ki := TKeurmeester.Create;
139.     ki.id := valarr[j];
140.     for i := 0 to n do
141.       tree.Find(ki);
142.     WriteLn('avl time in ms: ', MillisecondsBetween(Now, dt), '; result: ', IfThen(tree.Find(ki) <> nil, 'True', 'False'));
143.     ki.Free;
144.   end;
145.   tree.Free;
146.   ReadLn;
147. end.

results:

Code: [Select]

FGL prepare data: 1647
==========================
Check ID: 5378 loop count: 10000000
--------------------------
map time in ms: 828; result: True
==========================
Check ID: 478315 loop count: 10000000
--------------------------
map time in ms: 860; result: True
==========================
Check ID: 999998 loop count: 10000000
--------------------------
map time in ms: 818; result: True
==========================
Check ID: 99999999 loop count: 10000000
--------------------------
map time in ms: 807; result: False
AVL prepare data: 1875
==========================
Check ID: 5378 loop count: 10000000
--------------------------
avl time in ms: 545; result: True
==========================
Check ID: 478315 loop count: 10000000
--------------------------
avl time in ms: 509; result: True
==========================
Check ID: 999998 loop count: 10000000
--------------------------
avl time in ms: 546; result: True
==========================
Check ID: 99999999 loop count: 10000000
--------------------------
avl time in ms: 531; result: False


[avk]

If I understand the issue correctly: one need to maintain some list without duplicates.
The data structure, which must contain unique(by some criteria) values, is usually called Set. Obviously, TFPGObjectList cannot serve as a Set without significant modification.
As for TAvlTree, it should be noted that it works with untyped pointers and is therefore type unsafe.
Generic implementations of a Set(with some drawbacks) based on binary search tree or hash table are available in FPC in at least two packages: fcl-stl(units gset and ghashset) and rtl-generics(unit Generics.Collections).