Recent

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

ASerge

  • Hero Member
  • *****
  • Posts: 1388
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}
  4. {$MODESWITCH ADVANCEDRECORDS}
  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;
  18.     procedure Add(const Value: T);
  19.     procedure AddUnique(const Value: T);
  20.     procedure Clear;
  21.     function ToSortedArray: TSlot;
  22.     property Size: SizeInt read FSize;
  23.   end;
  24.  
  25. implementation
  26.  
  27. procedure TBinaryArraySet.Add(const Value: T);
  28. begin
  29.   if not Contains(Value) then
  30.     AddUnique(Value);
  31. end;
  32.  
  33. procedure TBinaryArraySet.AddUnique(const Value: T);
  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
  21.     IntSet.Add(i);
  22.     StrSet.Add(IntToStr(i));
  23.   end;
  24.   IntSet.Add(14);
  25.   StrSet.Add('14');
  26.   IntSet.Add(8);
  27.   StrSet.Add('8');
  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);
  35.   Readln;
  36. end.

howardpc

  • Hero Member
  • *****
  • Posts: 3096
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: 1388
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: 425
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: 1893
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.

howardpc

  • Hero Member
  • *****
  • Posts: 3096
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}
  5. {$ModeSwitch advancedrecords}
  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
  78.       False: wordSet.AddUnique(wcRec);
  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;
  93.   Readln;
  94. end.
The adapted unit:
Code: Pascal  [Select]
  1. unit uBinaryArraySet;
  2.  
  3. { adapted from code by ASerge }
  4.  
  5. {$Mode objfpc}
  6. {$LongStrings on}
  7. {$ModeSwitch advancedrecords}
  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;
  26.     procedure AddUnique(const Value: T);
  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
  71.              AddUnique(Value);
  72.              Result := True;
  73.            end;
  74.   end;
  75. end;
  76.  
  77. procedure TBinaryArraySet.AddUnique(const Value: T);
  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
  16.     crossroads  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
  90.            your  1
  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: 562
  • 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

  • Sr. Member
  • ****
  • Posts: 348
  • KISS principle / Lazarus 2.0.0 / FPC 3.0.4
Re: Choice between TList and dynamic array
« Reply #22 on: August 20, 2019, 09:15:46 am »
Hope this simple structure will be helpful.
procedure mulu64(a, b: QWORD; out clo, chi: QWORD); assembler;
asm
  mov rax, a
  mov rdx, b
  mul rdx
  mov [clo], rax
  mov [chi], rdx
end;
(* Pointer game *) Inc(ptr, 1); (* vs *) ptr := ptr + 1;