I have following statement in my Delphi 7 code.
TMyCharSet = set of char;
When I migrated that code to Delphi XE4, I am getting following compi
A set cannot contain items larger than a byte. Since Char
in UniCode Delphi is a WideChar
which is two bytes in size, a set type is an inappropriate container.
Here is an example of a generic set type based on a record, TSet<T>
. This means that you don't have to think about creation and destruction of variables of this type. Use this type as a container for simple types. I tried to mimic most of the behavior of the set type.
Addition and subtraction of items can be done with + and - operators. Added the in
operator as well.
Note: The record holds the data in a dynamic array. Assigning a variable to another will make both variables using the same dynamic array. A Copy-On-Write (COW) protection built-in will prevent a change in one variable to be reflected on the other one.
unit GenericSet;
interface
Uses
System.Generics.Defaults;
Type
TSet<T> = record
class operator Add(const aSet: TSet<T>; aValue: T) : TSet<T>; overload;
class operator Add(const aSet: TSet<T>; const aSetOfT: TArray<T>) : TSet<T>; overload;
class operator Add(const aSet1: TSet<T>; const aSet2: TSet<T>) : TSet<T>; overload;
class operator Subtract(const aSet: TSet<T>; aValue: T): TSet<T>; overload;
class operator Subtract(const aSet: TSet<T>; const aSetOfT: TArray<T>) : TSet<T>; overload;
class operator Subtract(const aSet1: TSet<T>; const aSet2: TSet<T>) : TSet<T>; overload;
class operator In(aValue: T; const aSet: TSet<T>): Boolean; overload;
class operator In(const aSetOf: TArray<T>; const aSet: TSet<T>): Boolean; overload;
class operator In(const aSet1: TSet<T>; const aSet2: TSet<T>): Boolean; overload;
private
FSetArray : TArray<T>;
function GetEmpty: Boolean;
public
procedure Add(aValue: T);
procedure AddSet(const setOfT: array of T); overload;
procedure AddSet(const aSet: TSet<T>); overload;
procedure Remove(aValue: T);
procedure RemoveSet(const setOfT: array of T); overload;
procedure RemoveSet(const aSet : TSet<T>); overload;
function Contains(aValue: T): Boolean; overload;
function Contains(const aSetOfT: array of T): Boolean; overload;
function Contains(const aSet : TSet<T>): Boolean; overload;
procedure Clear;
property Empty: Boolean read GetEmpty;
end;
implementation
procedure TSet<T>.Add(aValue: T);
begin
if not Contains(aValue) then begin
SetLength(FSetArray,Length(FSetArray)+1);
FSetArray[Length(FSetArray)-1] := aValue;
end;
end;
class operator TSet<T>.Add(const aSet: TSet<T>; aValue: T): TSet<T>;
begin
Result.AddSet(aSet.FSetArray);
Result.Add(aValue);
end;
class operator TSet<T>.Add(const aSet: TSet<T>; const aSetOfT: TArray<T>): TSet<T>;
begin
Result.AddSet(aSet.FSetArray);
Result.AddSet(aSetOfT);
end;
class operator TSet<T>.Add(const aSet1, aSet2: TSet<T>): TSet<T>;
begin
Result.AddSet(aSet1.FSetArray);
Result.AddSet(aSet2.FSetArray);
end;
procedure TSet<T>.AddSet(const setOfT: array of T);
var
i : Integer;
begin
for i := 0 to High(setOfT) do
Self.Add(setOfT[i]);
end;
procedure TSet<T>.AddSet(const aSet: TSet<T>);
begin
AddSet(aSet.FSetArray);
end;
procedure TSet<T>.RemoveSet(const setOfT: array of T);
var
i : Integer;
begin
for i := 0 to High(setOfT) do
Self.Remove(setOfT[i]);
end;
procedure TSet<T>.RemoveSet(const aSet: TSet<T>);
begin
RemoveSet(aSet.FSetArray);
end;
class operator TSet<T>.Subtract(const aSet1, aSet2: TSet<T>): TSet<T>;
begin
Result.AddSet(aSet1.FSetArray);
Result.RemoveSet(aSet2.FSetArray);
end;
class operator TSet<T>.Subtract(const aSet: TSet<T>;
const aSetOfT: TArray<T>): TSet<T>;
begin
Result.AddSet(aSet.FSetArray);
Result.RemoveSet(aSetOfT);
end;
class operator TSet<T>.Subtract(const aSet: TSet<T>; aValue: T): TSet<T>;
begin
Result.AddSet(aSet.FSetArray);
Result.RemoveSet(aValue);
end;
class operator TSet<T>.In(aValue: T; const aSet: TSet<T>): Boolean;
begin
Result := aSet.Contains(aValue);
end;
class operator TSet<T>.In(const aSetOf: TArray<T>; const aSet: TSet<T>): Boolean;
begin
Result := aSet.Contains(aSetOf);
end;
class operator TSet<T>.In(const aSet1: TSet<T>; const aSet2: TSet<T>): Boolean;
begin
Result := aSet2.Contains(aSet1.FSetArray);
end;
function TSet<T>.Contains(aValue: T): Boolean;
var
i : Integer;
c : IEqualityComparer<T>;
begin
c := TEqualityComparer<T>.Default;
Result := false;
for i := 0 to Length(FSetArray)-1 do
if c.Equals(FSetArray[i],aValue) then
Exit(True);
end;
function TSet<T>.GetEmpty: Boolean;
begin
Result := (Length(FSetArray) = 0);
end;
procedure TSet<T>.Clear;
begin
SetLength(FSetArray,0);
end;
function TSet<T>.Contains(const aSetOfT: array of T): Boolean;
var
i : Integer;
begin
Result := High(aSetOfT) >= 0;
for i := 0 to High(aSetOfT) do
begin
Result := Contains(ASetOfT[i]);
if not Result then
Exit(false);
end;
end;
function TSet<T>.Contains(const aSet: TSet<T>): Boolean;
begin
Result := Contains(aSet.FSetArray);
end;
procedure TSet<T>.Remove(aValue: T);
var
i : Integer;
c : IEqualityComparer<T>;
begin
c := TEqualityComparer<T>.Default;
for i := 0 to Length(FSetArray)-1 do
begin
if c.Equals(FSetArray[i],aValue) then
begin
SetLength(FSetArray,Length(FSetArray)); // Ensure unique dyn array
if (i < Length(FSetArray)-1) then
FSetArray[i] := FSetArray[Length(FSetArray)-1]; // Move last element
SetLength(FSetArray,Length(FSetArray)-1);
Break;
end;
end;
end;
end.
A sample test program:
program ProjectGenericSet;
{$APPTYPE CONSOLE}
uses
GenericSet in 'GenericSet.pas';
var
mySet,mySet1 : TSet<Char>;
begin
mySet.AddSet(['A','B','C']);
WriteLn(mySet.Contains('C'));
WriteLn(mySet.Contains('D')); // False
mySet := mySet + 'D';
WriteLn(mySet.Contains('D'));
WriteLn('D' in mySet);
mySet := mySet - 'D';
WriteLn(mySet.Contains('D')); // False
mySet := mySet + TArray<Char>.Create('D','E');
WriteLn(mySet.Contains('D'));
WriteLn(mySet.Contains(['A','D']));
mySet1 := mySet;
// Testing COW
mySet1.Remove('A');
WriteLn(mySet.Contains('A'));
mySet1:= mySet1 + mySet;
WriteLn(mySet1.Contains('A'));
mySet := mySet1;
mySet1.Clear;
WriteLn(mySet.Contains('A'));
ReadLn;
end.
You get the warning because XE4 uses WideChar for variable of Char type (and WideString for String), so Char takes 2 bytes instead of 1 byte now. Now it is possible to keep unicode characters in String/Char, but for same reason it is impossible to use set of char anymore (in Delphi it is fixed size, 32-bytes bits map and can keep up to 256 items so).
If you use only chars from range #0..#127 (only latin/regular symbols), then you can just replace Char -> AnsiChar (but when you will assign it from Char you will see another warning, you will have to use explicit type conversion to suppress it).
If you need national/unicode symbols, then there is no "ready to use" structure in Delphi, but you can use Tdictionary for this purpose:
type
TEmptyRecord = record end;
TSet<T> = class(TDictionary<T,TEmptyRecord>)
public
procedure Add(Value: T); reintroduce; inline;
procedure AddOrSetValue(Value: T); reintroduce; inline;
function Contains(Value: T):Boolean; reintroduce; inline;
end;
procedure TSet<T>.Add(Value: T);
var Dummy: TEmptyRecord;
begin
inherited AddOrSetValue(Value, Dummy);
end;
procedure TSet<T>.AddOrSetValue(Value: T);
var Dummy: TEmptyRecord;
begin
inherited AddOrSetValue(Value, Dummy);
end;
function TSet<T>.Contains(Value: T): Boolean;
begin
result := inherited ContainsKey(Value);
end;
Of course you will have initialize at as any other regular class. But it will be still quite efficient (not so fast as "set of" of course, just because "set" is always limited by 256 items max size but highly optimized).
Alternatively you can create your own set class for unicode chars as map of bits, it will take 8kb of memory to keep all the bits and will be almost as fast as "set of".
See fourm suggestions from web:
if not (CharInSet(Key,['0'..'9',#8]) then key := #0;
From: http://www.activedelphi.com.br/forum/viewtopic.php?t=66035&sid=f5838cc7dc991f7b3340e4e2689b222a