Sets

[HappyLarry]

1. Is there a way of storing more than 256 elements in a set?
e.g.
 type TSet = set of 0..255
is OK but you can't go above 255.

2. To count the elements in a set, GnuPascal has a 'card' function (according to Google). I can't find this in Free Pascal. Any ideas?

Thanks.

[marcov]

Afaik no, but there is the classes.TBits that emulates a larger bitfield.

[howardpc]

To count the elements in a set, GnuPascal has a 'card' function (according to Google). I can't find this in Free Pascal. Any ideas?

Probably not implemented because the set element type can vary greatly. It is straightforward to write the functionality yourself. A generic function would be more useful than what follows, but it gives the idea:

Code: [Select]

program Project1;

{$mode objfpc}{$H+}

type
  TCharSet = set of Char;

function CharSetElementCount(aSet: TCharSet): integer;
var
  c: Char;
begin
  Result:=0;
  for c in aSet do
    if (c in aSet) then Inc(Result);
end;

begin
  WriteLn('[a..z] as a set has ',CharSetElementCount(['a'..'z']),' members');
  ReadLn;
end.



[Leledumbo]

1. Is there a way of storing more than 256 elements in a set?

Use Classes.TBits as Marco said. In theory, language support can be implemented for >256 elements set, but:

• It's not practical. Currently, >32 elements set is implemented as array [0..7] of 32-bit integers, and uses slower code from <= 32 elements set, which can be efficiently implemented using bit manipulation on a single 32-bit integer.
• It's seldom near to never to have sets with >256 elements. Lazarus code uses set in many places, sometimes with a big enum elements, but none ever reached 256 or more.

2. To count the elements in a set, GnuPascal has a 'card' function (according to Google). I can't find this in Free Pascal. Any ideas?

Not implemented, unfortunately. GNU Pascal compatibility as a language has been dropped as well, there used to be {$mode gpc}. You can use for-in loop to calculate it manually as howard shows, or to make the operation fast, make a wrapper such that the variable holding current size is updated accordingly as elements are included/excluded from the set.

[marcov]

1. Is there a way of storing more than 256 elements in a set?

Use Classes.TBits as Marco said. In theory, language support can be implemented for >256 elements set, but:

• It's not practical. Currently, >32 elements set is implemented as array [0..7] of 32-bit integers, and uses slower code from <= 32 elements set, which can be efficiently implemented using bit manipulation on a single 32-bit integer.

It is not just efficiency. It really puts a scaling bomb under using enums and sets in the first place since on expansion you might hit the limit, IMHO confining these features to the homework realm.

Note that it is not just on elements, but on elements from 0, as demonstrated by this (non compiling) code:

Code: [Select]



type

   txx = set of 255..256;

var yy : txx;
begin
 writeln(sizeof(yy));
end.


2. To count the elements in a set, GnuPascal has a 'card' function (according to Google). I can't find this in Free Pascal. Any ideas?

(reply to original msg)
FPC 3.x has a popcnt instruction for register sized variables, e.g.

Code: [Select]

type

   txx = set of 0..31;

var yy : txx;
begin
  yy:=[1,4,3];
 writeln(popcnt(dword(yy)));
end.

Will print 3.

Not implemented, unfortunately. GNU Pascal compatibility as a language has been dropped as well, there used to be {$mode gpc}.

(Was reserved for gpc and iso dialect contributions, but never really took off)

[HappyLarry]

Thanks to everyone who replied.

I have tried using TBits and it is going quite well - AndBits, and OrBits work OK - but I can't get 'NotBits' to work properly.  It turns 1s to 0s but doesn't always turn 0s to 1s, 

The output below is 00100000, where I would expect 11100111.

I am probably doing something wrong, all help appreciated. Code (easy to follow) is below.

Code: [Select]

program project1;

uses
  Classes;

var
  A,B:TBits;

procedure ShowBits(P:TBits; Title:string);
var
  k:integer;
begin
  writeln(Title);
  For k:= 0 to 7 do
  begin
     If P[k] then
     begin
        write('1');
     end
     else
     begin
       write('0');
     end;
  end;
  writeln;
end;

begin
  writeln('TBit test');
  A:=TBits.create;
  A.Grow(8);
  A.ClearAll;

  B:=TBits.create;
  B.Grow(8);
  B.ClearAll;

  A.SetOn(2);
  A.SetOn(3);

  B.SetOn(3);
  B.SetOn(4);

  A.NotBits(B);

  ShowBits(A,'A');
  ShowBits(B,'B');
  readln;
end.

[Nitorami]

That looks indeed strange. The help says "NotBits performs a not operation on the bits in the array with the bits of array Bitset", whatever that means.
What is a "NOT with" operation ?  Maybe we just have a different understanding than the programmer. The source code is

Code: [Select]

   for loop := 0 to n do
   begin
      jj := FBits^[loop];
      FBits^[loop] := FBits^[loop] and (jj xor bitset.FBits^[loop]);
   end;     

in other words A := A and (A xor B).

[Leledumbo]

That looks indeed strange. The help says "NotBits performs a not operation on the bits in the array with the bits of array Bitset", whatever that means.
What is a "NOT with" operation ?  Maybe we just have a different understanding than the programmer. The source code is

Code: [Select]

   for loop := 0 to n do
   begin
      jj := FBits^[loop];
      FBits^[loop] := FBits^[loop] and (jj xor bitset.FBits^[loop]);
   end;     

in other words A := A and (A xor B).

Turning it to a truth table:

Code: [Select]

A - B - A and (A xor B)
0 - 0 - 0 and (0 xor 0) = 0 and 0 = 0
0 - 1 - 0 and (0 xor 1) = 0 and 1 = 0
1 - 0 - 1 and (1 xor 0) = 1 and 1 = 1
1 - 1 - 1 and (1 xor 1) = 1 and 0 = 0
Looks like a negation of implication.

[totya]

FPC 3.x has a popcnt instruction for register sized variables, e.g.

Code: [Select]

writeln(popcnt(dword(yy)));

Hi!

Thanks for this information, it works for me. The result is the element count of set.

[anyone]

It is good to have CPU instruction POPCNT introduced!

Back in my days in C#, I have to create my own subroutine to calculate the number of set bits (e.g. in 32-bit unsigned integer)

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

1. var
2.   number:UInt32;
3.   bits:UInt32;
4.   i:integer;
5.  
6. begin
7.   number:=8501; {10 0001 0011 0101}
8.   bits:=0;
9.   for i:=0 to 31 do
10.     bits:=bits + ((number shl (31-(i mod 32))) shr 31);
11.  
12.   WriteLn(bits); {6}
13.   ReadLn;
14.  
15. end.

The above function should be equivalent to POPCNT, but much slower, of course!

[winni]

Hi!

I did not know about popcnt in fpc.

I did it this way:

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

1. Function NumBitsOn (DW: Dword) : byte;
2. var
3.     WordBit :  record case boolean of
4.                true: (D: DWord);
5.                false:(B: bitpacked array[0..31] of 0..1);
6.                end;
7.     i: byte;
8.  
9. begin
10.   result := 0;
11.   WordBit.D := DW;
12.   for i := 0 to high(WordBit.B) do
13.        if WordBit.B[i] = 1 then inc(result);
14. end;                  
15.  

Winni

[egsuh]

Do not stick to the set concept itself. You can use TFPGMap or TStringList - sorted, no duplication of keys.

If you use TFPGMap, you have to provide dummy Data part, but what's the problem.

This could take more memory, but does what you want. And memory size would not be different much if your set is very sparce and requires large number.   

I myself use TFPGMap, every item of which is range,  with key is lower end, and data is higher end.
And written methods of adding, or deleting some part of it.

That is,

type
    TMySet = class (TFPGMap<integer, integer>)
         function AsString: string;
         function HasMember(i: integer): boolean;
    end;

For example,  if you want set of [1, 4, 9], TFPGMap  would have 3 items.

   1,1
   4,4
   9,9

function AsString will return 1,4,9.

But with set of [1..99], there would be only one item.

    1,99

And AsString will return 1..99.

But you will need some through thinking, in cases of

   [1,4,9] + [2..3]  which should produce [1..4, 9]. In this case, you need some algorithm.

I could define set operations like union, difference, and intersection.


 

[simone]

Probably not implemented because the set element type can vary greatly. It is straightforward to write the functionality yourself. A generic function would be more useful than what follows, but it gives the idea:

Code: [Select]

program Project1;

{$mode objfpc}{$H+}

type
  TCharSet = set of Char;

function CharSetElementCount(aSet: TCharSet): integer;
var
  c: Char;
begin
  Result:=0;
  for c in aSet do
    if (c in aSet) then Inc(Result);
end;

begin
  WriteLn('[a..z] as a set has ',CharSetElementCount(['a'..'z']),' members');
  ReadLn;
end.



Dear Howard, the expression

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

1. (c in aSet)

is always true. I think it's possible to simply write:

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

1. function CharSetElementCount(aSet: TCharSet): integer;
2. var
3.   c: Char;
4. begin
5.   Result:=0;
6.   for c in aSet do
7.     Inc(Result);
8. end;

[Thaddy]

I believe I gave this before:

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

1. {$mode objfpc}{$inline on}
2. { A simple way to implement large or huge sets.
3.  (c) 2019 Thaddy de Koning. No license and not
4.  re-licensable: free for all to use.
5.  Copyright holds:
6.  You can not claim license nor copyrigths }
7. unit largesets;
8. { Operator      Action
9.   ---------------------------------------------
10.   +             Union
11.   -             Difference
12.   *             Intersection
13.   ><        Symmetric difference
14.   <=        Contains
15.   include   Include an element in the set
16.   exclude   Exclude an element from the set
17.   in        Check if an element is in a set
18. }
19. interface
20. uses
21.   generics.collections;
22.  
23. type
24.   TWordSet  = specialize TSortedHashSet<word >;
25.   { The next two can cause some real memory pressure, be careful }
26.   TDWordSet = specialize TSortedHashSet<dword>;
27.   TQWordSet = specialize TSortedHashSet<Qword>;
28.  
29.   { union }
30.   operator + (const a,b:TWordset ):TWordSet;
31.   operator + (const a,b:TDWordset):TDWordSet;
32.   operator + (const a,b:TQWordset):TQWordSet;
33.  
34.   { difference }
35.   operator - (const a,b:Twordset ):TWordSet;
36.   operator - (const a,b:TDwordset):TDWordSet;
37.   operator - (const a,b:TQwordset):TQWordSet;
38.  
39.   { intersection }
40.   operator * (const a,b:TwordSet ):TWordSet;
41.   operator * (const a,b:TDwordSet):TDWordSet;
42.   operator * (const a,b:TQwordSet):TQWordSet;
43.  
44.   { symmetric difference }
45.   operator >< (const a,b:TWordSet ):TWordSet;
46.   operator >< (const a,b:TDWordSet):TDWordSet;
47.   operator >< (const a,b:TQWordSet):TQWordSet;
48.  
49.   { contains }
50.   operator <= (const a,b:TWordSet ):Boolean;
51.   operator <= (const a,b:TDWordSet):Boolean;
52.   operator <= (const a,b:TQWordSet):Boolean;
53.  
54.   { in }
55.   operator in (const a:word; const b:TWordset ):Boolean;
56.   operator in (const a:dword;const b:TDWordset):Boolean;
57.   operator in (const a:qword;const b:TQWordset):Boolean;
58.  
59.   { include }
60.   procedure include(const a:TWordSet; const b:Word);
61.   procedure include(const a:TDWordSet;const b:DWord);
62.   procedure include(const a:TQWordSet;const b:QWord);
63.  
64.   { exclude }
65.   procedure exclude(const a:TWordSet;const  b:Word);
66.   procedure exclude(const a:TDWordSet;const b:DWord);
67.   procedure exclude(const a:TQWordSet;const b:QWord);
68.  
69. implementation
70.  
71.   { union }
72.   operator + (const a,b:TWordset):TWordSet;
73.   begin  
74.     b.UnionWith(a);
75.     Result := b;
76.   end;  
77.  
78.   operator + (const a,b:TDWordset):TDWordSet;
79.   begin
80.     b.UnionWith(a);
81.     Result := b;
82.   end;
83.  
84.   operator + (const a,b:TQWordset):TQWordSet;
85.   begin
86.     b.UnionWith(a);
87.     Result := b;
88.   end;
89.  
90.   { difference }
91.   operator -(const a,b:Twordset):TWordSet;
92.   begin
93.     b.ExceptWith(a);
94.     result:=b;
95.   end;
96.  
97.   operator -(const a,b:TDwordset):TDWordSet;
98.   begin
99.     b.ExceptWith(a);
100.     result:=b;
101.   end;
102.  
103.   operator -(const a,b:TQwordset):TQWordSet;
104.   begin
105.     b.ExceptWith(a);
106.     result:=b;
107.   end;
108.  
109.   { intersection }
110.   operator *(const a,b:TwordSet):TWordSet;
111.   begin
112.     b.IntersectWith(a);
113.     Result := b;
114.   end;
115.  
116.   operator *(const a,b:TDwordSet):TDWordSet;
117.   begin
118.     b.IntersectWith(a);
119.     Result := b;
120.   end;
121.  
122.   operator *(const a,b:TQwordSet):TQWordSet;
123.   begin
124.     b.IntersectWith(a);
125.     Result := b;
126.   end;
127.  
128.   { symmetric difference }
129.   operator ><(const a,b:TWordSet):TWordSet;
130.   begin
131.     b.SymmetricExceptWith(a);
132.     Result := b;
133.   end;
134.  
135.   operator ><(const a,b:TDWordSet):TDWordSet;
136.   begin
137.     b.SymmetricExceptWith(a);
138.     Result := b;
139.   end;
140.  
141.   operator ><(const a,b:TQWordSet):TQWordSet;
142.   begin
143.     b.SymmetricExceptWith(a);
144.     Result := b;
145.   end;
146.  
147.   { contains }
148.   operator <=(const a,b:TWordSet):Boolean;
149.   var
150.     c:word;
151.   begin
152.     Result := true;
153.     for c in a do
154.     if not b.contains(c) then
155.     begin
156.       Result := False;
157.       break;
158.     end;
159.   end;
160.  
161.   operator <=(const a,b:TDWordSet):Boolean;
162.   var
163.     c:word;
164.   begin
165.     Result := true;
166.     for c in a do
167.     if not b.contains(c) then
168.     begin
169.       Result := False;
170.       break;
171.     end;
172.   end;
173.  
174.   operator <=(const a,b:TQWordSet):Boolean;
175.   var
176.     c:word;
177.   begin
178.     Result := true;
179.     for c in a do
180.     if not b.contains(c) then
181.     begin
182.       Result := False;
183.       break;
184.     end;
185.   end;
186.  
187.   { in }
188.   operator in (const a:word;const b:TWordset):Boolean;
189.   begin
190.     Result := b.Contains(a);
191.   end;  
192.  
193.   operator in (const a:dword;const b:TDWordset):Boolean;
194.   begin
195.     Result := b.Contains(a);
196.   end;
197.  
198.   operator in (const a:qword;const b:TQWordset):Boolean;
199.   begin
200.     Result := b.Contains(a);
201.   end;
202.  
203.   { include }
204.   procedure include(const a:TWordSet;const b:Word);
205.   begin
206.     a.Add(b);
207.   end;
208.  
209.   procedure include(const a:TDWordSet;const b:DWord);
210.   begin
211.     a.Add(b);
212.   end;
213.  
214.   procedure include(const a:TQWordSet;const b:QWord);
215.   begin
216.     a.Add(b);
217.   end;
218.  
219.   { exclude }
220.   procedure exclude(const a:TWordSet;const b:Word);
221.   begin
222.     a.Remove(b);
223.   end;
224.  
225.   procedure exclude(const a:TDWordSet;const b:DWord);
226.   begin
227.     a.Remove(b);
228.   end;
229.  
230.   procedure exclude(const a:TQWordSet;const b:QWord);
231.   begin
232.     a.Remove(b);
233.   end;
234.  
235. end.

Behaves near to identical to the built-in set type.

[howardpc]

Dear Howard, the expression

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

1. (c in aSet)

is always true.

You are correct. That test is completely redundant.