### Bookstore

 Computer Math and Games in Pascal (preview) Lazarus Handbook

### Author Topic: Choice between TList and dynamic array  (Read 2312 times)

#### ASerge

• Hero Member
• Posts: 1684
##### Re: Choice between TList and dynamic array
« Reply #15 on: August 19, 2019, 07:35:53 pm »
Is there a generic implementation of this anywhere for Pascal?
Not hard to do. Here, for example
Code: Pascal  [Select][+][-]
1. unit BinaryArraySet;
2.
3. {\$MODE OBJFPC}
5.
6. interface
7.
8. type
9.   generic TBinaryArraySet<T> = record
10.   strict private type
11.     TSlot = array of T;
12.   strict private
13.     FData: array of TSlot;
14.     FSize: SizeInt;
15.     function MergeSlots(const Left, Right: TSlot): TSlot;
16.   public
17.     function Contains(const Value: T): Boolean;
20.     procedure Clear;
21.     function ToSortedArray: TSlot;
22.     property Size: SizeInt read FSize;
23.   end;
24.
25. implementation
26.
28. begin
29.   if not Contains(Value) then
31. end;
32.
34. var
35.   Temp: TSlot;
36.   DataIndex, DataCount: SizeInt;
37. begin
38.   Inc(FSize);
39.   SetLength(Temp, 1);
40.   Temp[0] := Value;
41.   DataCount := Length(FData);
42.   for DataIndex := 0 to DataCount - 1 do
43.   begin
44.     if not Assigned(FData[DataIndex]) then
45.     begin
46.       FData[DataIndex] := Temp;
47.       Exit;
48.     end;
49.     Temp := MergeSlots(Temp, FData[DataIndex]);
50.     FData[DataIndex] := nil;
51.   end;
52.   SetLength(FData, DataCount + 1);
53.   FData[DataCount] := Temp;
54. end;
55.
56. procedure TBinaryArraySet.Clear;
57. begin
58.   FData := nil;
59.   FSize := 0;
60. end;
61.
62. function TBinaryArraySet.Contains(const Value: T): Boolean;
63. var
64.   DataIndex: SizeInt;
65.   StartIndex, EndIndex, MiddleIndex: SizeInt;
66. begin
67.   for DataIndex := 0 to High(FData) do
68.   begin
69.     if not Assigned(FData[DataIndex]) then
70.       Continue;
71.     StartIndex := 0;
72.     EndIndex := Length(FData[DataIndex]);
73.     while StartIndex < EndIndex do
74.     begin
75.       MiddleIndex := (StartIndex + EndIndex) div 2;
76.       if Value < FData[DataIndex][MiddleIndex] then
77.         EndIndex := MiddleIndex
78.       else
79.         if Value > FData[DataIndex][MiddleIndex] then
80.           StartIndex := MiddleIndex + 1
81.         else
82.           Exit(True);
83.     end;
84.   end;
85.   Result := False;
86. end;
87.
88. function TBinaryArraySet.MergeSlots(const Left, Right: TSlot): TSlot;
89. var
90.   LeftIndex, RightIndex, ResultIndex: SizeInt;
91.   LeftCount, RightCount, ResultCount: SizeInt;
92. begin
93.   LeftCount := Length(Left);
94.   RightCount := Length(Right);
95.   ResultCount := LeftCount + RightCount;
96.   SetLength(Result, ResultCount);
97.   LeftIndex := 0;
98.   RightIndex := 0;
99.   ResultIndex := 0;
100.   while (LeftIndex < LeftCount) and (RightIndex < RightCount) do
101.   begin
102.     if Left[LeftIndex] < Right[RightIndex] then
103.     begin
104.       Result[ResultIndex] := Left[LeftIndex];
105.       Inc(LeftIndex);
106.     end
107.     else
108.     begin
109.       Result[ResultIndex] := Right[RightIndex];
110.       Inc(RightIndex);
111.     end;
112.     Inc(ResultIndex);
113.   end;
114.   while LeftIndex < LeftCount do
115.   begin
116.     Result[ResultIndex] := Left[LeftIndex];
117.     Inc(LeftIndex);
118.     Inc(ResultIndex);
119.   end;
120.   while RightIndex < RightCount do
121.   begin
122.     Result[ResultIndex] := Right[RightIndex];
123.     Inc(RightIndex);
124.     Inc(ResultIndex);
125.   end;
126. end;
127.
128. function TBinaryArraySet.ToSortedArray: TSlot;
129. var
130.   DataIndex: SizeInt;
131. begin
132.   Result := nil;
133.   for DataIndex := 0 to High(FData) do
134.     Result := MergeSlots(Result, FData[DataIndex]);
135. end;
136.
137. end.
Code: Pascal  [Select][+][-]
1. program project1;
2. {\$MODE OBJFPC}
3. {\$APPTYPE CONSOLE}
4. {\$LONGSTRINGS ON}
5.
6. uses SysUtils, BinaryArraySet;
7.
8. type
9.   TIntBinaryArraySet = specialize TBinaryArraySet<Integer>;
10.   TStringBinaryArray = specialize TBinaryArraySet<string>;
11.
12. var
13.   i: SizeInt;
14.   IntSet: TIntBinaryArraySet;
15.   StrSet: TStringBinaryArray;
16.   IntArray: array of Integer;
17.   StrArray: array of string;
18. begin
19.   for i := 13 downto 0 do
20.   begin
23.   end;
28.   IntArray := IntSet.ToSortedArray;
29.   for i := 0 to High(IntArray) do
30.     Write(IntArray[i]:3);
31.   Writeln;
32.   StrArray := StrSet.ToSortedArray;
33.   for i := 0 to High(StrArray) do
34.     Write(StrArray[i]:3);
36. end.

#### howardpc

• Hero Member
• Posts: 3555
##### Re: Choice between TList and dynamic array
« Reply #16 on: August 19, 2019, 07:47:02 pm »
Great, thanks ASerge!
I notice you implemented Size as a property updated from the AddUnique method.
Is there a particular reason you prefer that over a GetSize function that sums the length of the slots?
« Last Edit: August 19, 2019, 08:00:57 pm by howardpc »

#### ASerge

• Hero Member
• Posts: 1684
##### Re: Choice between TList and dynamic array
« Reply #17 on: August 19, 2019, 08:26:11 pm »
Is there a particular reason you prefer that over a GetSize function that sums the length of the slots?
You are right, GetSize will be more correct also for the reason that the FSize field is not of a managed type, which means that for a variable on the stack (not global, as in the example) its value will not be zero, but a random number.

#### mas steindorff

• Sr. Member
• Posts: 444
##### Re: Choice between TList and dynamic array
« Reply #18 on: August 20, 2019, 01:59:09 am »
one thing no one has said is how ez it is to add functionality to a Tlist. You can add sorting and filtering just by pointing the Tlist to the compare function of your choice.
windows 7/10 - laz 2.0 / 1.2.6 general releases

#### jamie

• Hero Member
• Posts: 3675
##### Re: Choice between TList and dynamic array
« Reply #19 on: August 20, 2019, 03:24:28 am »
Yup and I have a couple of apps that use the hell out of Variants.

With the speed of todays computers moving 16 bytes of info is no big deal since that can be done
very quickly now.

And yes you can have a type-less method to receive two items and do the compare.
The only true wisdom is knowing you know nothing

#### howardpc

• Hero Member
• Posts: 3555
##### Re: Choice between TList and dynamic array
« Reply #20 on: August 20, 2019, 05:40:00 am »
Here's an example adapted from ASerge's generic code for Binary Array Set that parses ANSI text very simply to give a frequency chart.
Code: Pascal  [Select][+][-]
1. program TestBinaryArraySet;
2.
3. {\$Mode objfpc}
4. {\$IfDef Windows} {\$AppType console} {\$EndIf}
6. {\$LongStrings ON}
7.
8. uses SysUtils, uBinaryArraySet, Types;
9.
10. type
11.
12.   TWordCount = record
13.     word: String;
14.     count: Word;
15.     class operator =(const a, b: TWordCount): Boolean;
16.     class operator <(const a, b: TWordCount): Boolean;
17.     class operator >(const a, b: TWordCount): Boolean;
18.     procedure Init(const aWord: String);
19.     procedure IncCount;
20.   end;
21.
22.   TWordBinarySet = specialize TBinaryArraySet<TWordCount>;
23.
24. class operator TWordCount. = (const a, b: TWordCount): Boolean;
25. begin
26.   Exit(a.word = b.word);
27. end;
28.
29. class operator TWordCount.<(const a, b: TWordCount): Boolean;
30. begin
31.   Exit(a.word < b.word);
32. end;
33.
34. class operator TWordCount.>(const a, b: TWordCount): Boolean;
35. begin
36.   Exit(a.word > b.word);
37. end;
38.
39. procedure TWordCount.Init(const aWord: String);
40. begin
41.   word := aWord;
42.   count := 1;
43. end;
44.
45. procedure TWordCount.IncCount;
46. begin
47.   Inc(count);
48. end;
49.
50. const
51.   test =
52.     'Look Wisdom calls out and Discernment lifts her voice. '+
53.     'At the top of the heights, on the way, at the crossroads she takes her stand, '+
54.     'by the gates, at the city''s entrance, at the approach to the portals, she shouts: '+
55.     'To you men I call out, and my voice to humankind. '+
56.     'Understand shrewdness, you dupes, and fools make your heart understand. '+
57.     'Listen, for I speak noble things, my mouth''s utterance - uprightness. '+
58.     'For my tongue declares truth and my lips loathe wickedness. '+
59.     'In the right are all my mouth''s sayings, nothing in them is twisted or crooked. '+
60.     'They are all plain to the discerning and straightforward to those who find knowledge. '+
61.     'Take my reproof rather than silver, and knowledge is choicer than fine gold. '+
62.     'For wisdom is better than rubies, all precious things cannot match her worth.';
63. var
64.   i, si, wi: Integer;
65.   wcRec: TWordCount;
66.   wordSet: TWordBinarySet;
67.   wordCountArray: array of TWordCount;
68.   words: TStringDynArray;
69.   wordCount: Word = 0;
70.
71. begin
72.   wordSet.Clear;
73.   words := ParsedToLoCaseWords(test);
74.   for i := 0 to High(words) do
75.   begin
76.     wcRec.Init(words[i]);
77.     case wordSet.Contains(wcRec, si, wi) of
79.       True:  wordSet.Slots[si][wi].IncCount;
80.     end;
81.   end;
82.   WriteLn('frequency':26);
83.   WriteLn;
84.   wordCountArray := wordSet.ToSortedArray;
85.   for i := 0 to High(wordCountArray) do
86.     begin
87.       WriteLn(wordCountArray[i].word:15, ' ',wordCountArray[i].count:2);
88.       Inc(wordCount, wordCountArray[i].count);
89.     end;
90.   WriteLn;
91.   WriteLn('Size of WordSet = ',wordSet.GetSize,'   Overall word count = ',wordCount);
92.   wordSet.Clear;
94. end.
Code: Pascal  [Select][+][-]
1. unit uBinaryArraySet;
2.
3. { adapted from code by ASerge }
4.
5. {\$Mode objfpc}
6. {\$LongStrings on}
8.
9. interface
10.
11. uses
12.   Types, sysutils;
13.
14. type
15.
16.   generic TBinaryArraySet<T> = record
17.   strict private type
18.     TSlots = array of T;
19.   strict private
20.     function MergeSlots(const Left, Right: TSlots): TSlots;
21.   public
22.     Slots: array of TSlots;
23.     function Contains(const Value: T): Boolean; overload;
24.     function Contains(const value: T; out DataIdx, SlotsIdx: Integer): Boolean; overload;
25.     function Added(const Value: T): Boolean;
27.     procedure Clear;
28.     function ToSortedArray: TSlots;
29.     function GetSize: SizeInt;
30.   end;
31.
32.   function ParsedToLoCaseWords(aLine: String): TStringDynArray;
33.
34. implementation
35.
36. function ParsedToLoCaseWords(aLine: String): TStringDynArray;
37. var
38.   wrd: String = '';
39.   p, resultIdx: Integer;
40.   c: Char;
41. begin
42.   aLine := Trim(aLine);
43.   SetLength(Result, Length(aLine) shr 1);
44.   resultIdx := 0;
45.   for p := 1 to Length(aLine) do
46.     begin
47.       c := LowerCase(aLine[p]);
48.       case (c in ['''', 'a'..'z']) of
49.         False: if Length(wrd) > 0 then
50.                  begin
51.                    Result[resultIdx] := wrd;
52.                    Inc(resultIdx);
53.                    wrd := '';
54.                  end;
55.         True:  wrd := wrd + c;
56.       end;
57.     end;
58.   if wrd <> '' then
59.     begin
60.       Result[resultIdx] := wrd;
61.       Inc(resultIdx);
62.     end;
63.   SetLength(Result, resultIdx);
64. end;
65.
66. function TBinaryArraySet.Added(const Value: T): Boolean;
67. begin
68.   case Contains(Value) of
69.     True:  Result := False;
70.     False: begin
72.              Result := True;
73.            end;
74.   end;
75. end;
76.
78. var
79.   Temp: TSlots;
80.   DataIndex: SizeInt;
81. begin
82.   SetLength(Temp, 1);
83.   Temp[0] := Value;
84.   for DataIndex := 0 to High(Slots) do
85.   begin
86.     if not Assigned(Slots[DataIndex]) then
87.     begin
88.       Slots[DataIndex] := Temp;
89.       Exit;
90.     end;
91.     Temp := MergeSlots(Temp, Slots[DataIndex]);
92.     Slots[DataIndex] := nil;
93.   end;
94.   SetLength(Slots, Length(Slots) + 1);
95.   Slots[High(Slots)] := Temp;
96. end;
97.
98. procedure TBinaryArraySet.Clear;
99. begin
100.   Slots := Nil;
101. end;
102.
103. function TBinaryArraySet.Contains(const Value: T): Boolean;
104. var
105.   slotIndex: SizeInt;
106.   startIndex, endIndex, midIndex: SizeInt;
107. begin
108.   for slotIndex := 0 to High(Slots) do
109.   begin
110.     if not Assigned(Slots[slotIndex]) then
111.       Continue;
112.     startIndex := 0;
113.     endIndex := Length(Slots[slotIndex]);
114.     while startIndex < endIndex do
115.     begin
116.       midIndex := (startIndex + endIndex) shr 1;
117.       if Value = Slots[slotIndex][midIndex] then
118.         Exit(True);
119.       if Value < Slots[slotIndex][midIndex] then
120.         endIndex := midIndex
121.       else
122.         startIndex := midIndex + 1;
123.     end;
124.   end;
125.   Result := False;
126. end;
127.
128. function TBinaryArraySet.Contains(const value: T; out DataIdx, SlotsIdx: Integer): Boolean;
129. var
130.   slotIndex: SizeInt;
131.   startIndex, endIndex, midIndex: SizeInt;
132. begin
133.   for slotIndex := 0 to High(Slots) do
134.   begin
135.     if not Assigned(Slots[slotIndex]) then
136.       Continue;
137.     startIndex := 0;
138.     endIndex := Length(Slots[slotIndex]);
139.     while startIndex < endIndex do
140.     begin
141.       midIndex := (startIndex + endIndex) div 2;
142.       if Value = Slots[slotIndex][midIndex] then
143.         begin
144.           DataIdx := slotIndex;
145.           SlotsIdx := midIndex;
146.           Exit(True);
147.         end;
148.         if Value < Slots[slotIndex][midIndex] then
149.         endIndex := midIndex
150.       else
151.         startIndex := midIndex + 1;
152.     end;
153.   end;
154.   Result := False;
155.   DataIdx := -1;
156.   SlotsIdx := -1;
157. end;
158.
159. function TBinaryArraySet.MergeSlots(const Left, Right: TSlots): TSlots;
160. var
161.   leftIndex: SizeInt = 0;
162.   rightIndex: SizeInt = 0;
163.   resultIndex: SizeInt = 0;
164. begin
165.   SetLength(Result, Length(Left) + Length(Right));
166.
167.   while (leftIndex < Length(Left)) and (rightIndex < Length(Right)) do
168.   begin
169.     if Left[leftIndex] < Right[rightIndex] then
170.     begin
171.       Result[resultIndex] := Left[leftIndex];
172.       Inc(leftIndex);
173.     end
174.     else
175.     begin
176.       Result[resultIndex] := Right[rightIndex];
177.       Inc(rightIndex);
178.     end;
179.     Inc(resultIndex);
180.   end;
181.
182.   while leftIndex < Length(Left) do
183.   begin
184.     Result[resultIndex] := Left[leftIndex];
185.     Inc(leftIndex);
186.     Inc(resultIndex);
187.   end;
188.
189.   while rightIndex < Length(Right) do
190.   begin
191.     Result[resultIndex] := Right[rightIndex];
192.     Inc(rightIndex);
193.     Inc(resultIndex);
194.   end;
195. end;
196.
197. function TBinaryArraySet.ToSortedArray: TSlots;
198. var
199.   slotIdx: SizeInt;
200. begin
201.   Result := Nil;
202.   for slotIdx := 0 to High(Slots) do
203.     Result := MergeSlots(Result, Slots[slotIdx]);
204. end;
205.
206. function TBinaryArraySet.GetSize: SizeInt;
207. var
208.   slotIdx: Integer;
209. begin
210.   Result := 0;
211.   for slotIdx := 0 to High(Slots) do
212.     if Assigned(Slots[slotIdx]) then
213.       Inc(Result, Length(Slots[slotIdx]));
214. end;
215.
216. end.
And the output:
Code: Pascal  [Select][+][-]
1.                   frequency
2.
3.             all  3
4.             and  6
5.        approach  1
6.             are  2
7.              at  4
8.          better  1
9.              by  1
10.            call  1
11.           calls  1
12.          cannot  1
13.         choicer  1
14.          city's  1
15.        crooked  1
17.       declares  1
18.     discerning  1
19.    discernment  1
20.          dupes  1
21.       entrance  1
22.           find  1
23.           fine  1
24.          fools  1
25.            for  3
26.          gates  1
27.           gold  1
28.          heart  1
29.        heights  1
30.            her  3
31.      humankind  1
32.              i  2
33.             in  2
34.             is  3
35.      knowledge  2
36.          lifts  1
37.           lips  1
38.         listen  1
39.         loathe  1
40.           look  1
41.           make  1
42.          match  1
43.            men  1
44.        mouth's  2
45.              my  6
46.           noble  1
47.         nothing  1
48.              of  1
49.              on  1
50.              or  1
51.             out  2
52.           plain  1
53.         portals  1
54.        precious  1
55.          rather  1
56.         reproof  1
57.           right  1
58.          rubies  1
59.         sayings  1
60.             she  2
61.          shouts  1
62.      shrewdness  1
63.          silver  1
64.           speak  1
65.           stand  1
66. straightforward  1
67.            take  1
68.           takes  1
69.            than  3
70.             the 10
71.            them  1
72.            they  1
73.          things  2
74.           those  1
75.              to  5
76.          tongue  1
77.             top  1
78.           truth  1
79.         twisted  1
80.      understand  2
81.     uprightness  1
82.       utterance  1
83.           voice  2
84.             way  1
85.             who  1
86.      wickedness  1
87.          wisdom  2
88.           worth  1
89.             you  2
91.
92. Size of WordSet = 88   Overall word count = 136

« Last Edit: August 20, 2019, 06:27:42 am by howardpc »

#### PascalDragon

• Hero Member
• Posts: 2284
• Compiler Developer
##### Re: Choice between TList and dynamic array
« Reply #21 on: August 20, 2019, 09:03:48 am »
Even with dynamic array you can implement nice and useful DS and algos.
Here my short (you can add Find func.) impl. of Binary Array Set.
@julkas
Thanks for pointing out this little-known data structure, which I had not encountered before.
Pascal sets are such a fundamental and useful language feature, but have the limitations of holding no more than 256 elements, and lack built-in routines for counting the number of elements present, or for listing the sorted elements, which means you have to write such routines yourself every time you need them.
With FPC 3.2 you can write generic functions for that which you can then use for any set type.

#### julkas

• Guest
##### Re: Choice between TList and dynamic array
« Reply #22 on: August 20, 2019, 09:15:46 am »
Hope this simple structure will be helpful.