Post by LuigiPaoloShould I replace the string following that only works with type SET
(TMySET - [IndexA] - [IndexB])
with (TMyARRAY - [IndexA] - [IndexB])
What is that supposed to accomplish? Sets and arrays are very different
things. In mathematics a set is an unordered collection of items (an
item either is a member of the set or not, an item cannot be contained
more than once it a set, there is no "index" for an item to define its
position in the set). The operation above returns a set that excludes
the two items IndexA and IndexB from the items in MySet (T is commonly
used as prefix for types, not variables, by the way). That would be
equivalent of
var
A, B: TMySet;
begin
... put some items into set A
B:= A;
Exclude(B, IndexA);
Exclude(B, IndexB);
Delphi sets implement the mathematical concept of sets, but they are
limited to 256 members due to the way they are implemented.
Arrays, on the other hand, are just containers for items, a collection
of slots for items. The same item can be contained any number of times
in the array, in different slots. Depending on the type of the items it
may even be difficult to decide if a slot is empty (has not been
assigned an item).
Given this, what is a subtraction operation A - B on two arrays A and B
supposed to do?
If what you are *really* looking for is a way to have sets with more
than 256 members, look at this CodeCentral entry:
http://cc.embarcadero.com/Item/26658
This gives an example of one way to do this. Here is another old unit I
found on my disk. The CommonTypesU unit it uses can be found in the zip
archive of the Codecentral entry. It's Win32 only, though, due to the
assembly routines.
{== Bitsets ======================================================}
{! <summary>
This unit implements a class of large sets (up to 512K members)
with the requisite methods to perform set operations. </summary>
<author>Dr. Peter Below</author>
<history>
<para>Version 1.0 created 1996-05-13</para>
<para>Version 1.1 created 2009-03-29, updated comments to XML,
checked for Unicode issues, removed Delphi 1 compatibility code.</para>
<para>Last modified 2009-03-29</para>
</history>
<remarks>
These sets take only numbers (LongInts) in the range 0..524287
(Delphi 1.0) as members. The maximum value for a specific set
has to be defined at creation time. However, it is possible
to copy a set to another set with larger capacity.</remarks>
<copyright>Copyright 2009 by Dr. Peter Below</copyright>
<licence> The code in this unit is released to the public domain without
restrictions for use or redistribution. Just leave the copyright note
above intact. The code carries no warranties whatsoever, use at your
own risk!</licence>}
{======================================================================}
unit Bitsets;
{$BOOLEVAL OFF} {Unit depends on shortcut boolean evaluation}
{$IFDEF CLR}
This unit cannot be used in a .NET project!
{$ENDIF}
interface
uses Windows, Classes, SysUtils;
const
{! Number of bits in one element of the internal array used by the
<see cref="THugeSet"/> class.
}
BitsPerUnit = Sizeof(Cardinal) * 8;
{! Number of bytes in one element of the internal array used by the
<see cref="THugeSet"/> class.
}
BytesPerUnit = Sizeof(Cardinal);
{! Highest value for a set member that can be used with the
<see cref="THugeSet"/> class.
}
MaxMember = High(LongInt);
type
{! <remarks>
Exception class used to report errors in the <see cref="THugeSet"/>
class.</remarks>
}
EHugeSetException = class(Exception);
{! <remarks>
Prototype for a callback function used with the <see
cref="THugeSet.EnumBits"/>
method. The function will be called for each member of the
set.</remarks>
<returns>true to continue the enumeration, false to stop
it.</returns>
<param name="setBit">is the ordinal value of the set member.</param>
<param name="lparam">is an optional value defined by the caller of
EnumBits.
Usually used to pass an object reference, for instance.</param>
}
TEnumBitsProc = function(setBit: Longint; lparam: LPARAM): Boolean;
{! This is the type of an element of the internal array used by the
<see cref="THugeSet"/> class.
}
TBitset = set of 0..BitsPerUnit - 1;
{! This type defines the maximum size of the internal array used by
the
<see cref="THugeSet"/> class. A variable of this type is never
actually used.
}
TBitsetArray = array[0..High(Cardinal) div (2 * Sizeof(TBitset)) - 1]
of TBitset;
{! This is the type used for the the internal array used by the
<see cref="THugeSet"/> class. The actual size of the array will
be smaller than TBitsetArray, though. }
PBitsetArray = ^TBitsetArray;
{! <remarks>
This class implements a set that can have up to MaxMember elements.
Set operations are provided through appropriate methods. The size of
the set is fixed at creation but a set can be copied to a new set
with
larger size, if needed. Elements of the set are defined by their
ordinal number, which can range from 0 to MaxMember.
<para>
The implementation of the class is very similar to the <see
cref="TBitArray"/>
class, since a set in Delphi is basically just an array of bits. It
just adds methods for the set operations. However, this class can be
used for published properties of components, since it derives from
TPersistent and supports streaming.</para></remarks>
}
THugeSet = class(TPersistent)
private
FSize: Cardinal; {Size of the internal array in longwords}
FMax: LongInt; {Ordinal of the largest member we can handle}
FMem: PBitsetArray; {Pointer to the bit storage}
{! Allocates storage for highestMember bits. }
procedure CreateStorage(highestMember: LongInt);
{! Read the array of bits from the passed stream }
procedure ReadData(Stream: TStream);
{! Returns the size of the storage array in bytes. }
function StorageSizeInBytes: LongInt;
{! Write the array of bits to the passed stream }
procedure WriteData(Stream: TStream);
protected
{! <summary>
Write accessor for the <see cref="THugeSet.Bits"/>
property.</summary>
<param name="atIndex">is the ordinal of the member to include in or
exclude from the set.</param>
<param name="toValue">determines the operation, true to include the
member (set the bit), false to exclude it (clear the bit).</param>
<exception cref="EHugeSetException">is raised if range checks are
on and atIndex is not in the range 0 to MaxMember.</exception>
}
procedure SetBit(atIndex: LongInt; toValue: Boolean);
{! <summary>
Read accessor for the <see cref="THugeSet.Bits"/>
property.</summary>
<returns>true if the member is in the set (the bit is set), false
if it is not in the set (the bit is not set).</returns>
<param name="atIndex">is the ordinal of the member check for set
membership.</param>
<exception cref="EHugeSetException">is raised if range checks are
on and atIndex is not in the range 0 to MaxMember.</exception>
}
function GetBit(atIndex: LongInt): Boolean;
{! <summary>
Returns the count of members (set bits) in the set.</summary>
}
function GetCount: LongInt;
{! <summary>
Called by the VCL streaming system if this class is used for a
published property of a design-time component. The method defines
a binary property "Bits" and provides the filer with the ReadData
and WriteData methods, which implement the classes streaming
mechanism.</summary>
}
procedure DefineProperties(Filer: TFiler); override;
{! <summary>
Returns the number of storage longwords to process when doing a
set
operation with this and the passed Source set.</summary>
<returns>the size, in longwords, of the smaller sets
storage.</returns>}
function ElementsToProcess(Source: THugeSet): Cardinal;
{! <value>
Returns the address of the internal storage.</value>
}
property Mem: PBitsetArray read FMem;
public
{! <summary>
Create a set for up to highestMember elements. </summary>
<exception cref="EInvalidParameter">is raised if higherstMember is
smaller than 0.</exception>}
constructor Create(highestMember: LongInt); virtual;
destructor Destroy; override;
{! <summary>
Set all bits to 0, giving us an empty set.</summary>
}
procedure Clear;
{! <summary>
Copy the content of the Source set to this one. </summary>
<param name="Source">is the set to copy. Cannot be nil and has to
be
a THugeSet or descendent therof.</param>
<exception cref="EParameterCannotBeNil">is raised if Source is
nil.</exception>
<exception cref="EConvertError">is raised if Source is not a
THugeSet.</exception>
<remarks>
The assignment does not change the size of this set, so if the
Source set contains less bits than this set the extra bits will
be cleared. If the Source set contains more bits only the
part fitting into this sets storage will be copied.</remarks>
}
procedure Assign(Source: TPersistent); override;
{! <summary>
Perform a bitwise OR operation on this and the passed Source
set.</summary>
<param name="Source">is the set to merge this one with. Cannot be
nil.</param>
<exception cref="EParameterCannotBeNil">is raised if Source is
nil.</exception>
<remarks>
As a result this set will have all bits set that were originally
set
in it or the Source set. However, if the Source set is larger only
the overlapping part will be processed, the operation will not
resize
this set. </remarks>
}
procedure Merge(Source: THugeSet); { A or B }
{! <summary>
Perform a bitwise AND operation on this and the passed Source
set.</summary>
<param name="Source">is the set to intersect this one with. Cannot
be nil.</param>
<exception cref="EParameterCannotBeNil">is raised if Source is
nil.</exception>
<remarks>
As a result this set will have all bits set that were originally
set
in it and the Source set. However, if the Source set is smaller
only
the overlapping part will be processed, any extra set bits will
remain
set.</remarks>
}
procedure Intersect(Source: THugeSet); { A and B }
{! <summary>
Perform a exclusive OR operation on this and the passed Source
set.</summary>
<param name="Source">is the set to merge this one with. Cannot be
nil.</param>
<exception cref="EParameterCannotBeNil">is raised if Source is
nil.</exception>
<remarks>
As a result this set will have all bits set that were originally
set
in it or the Source set, but not in both. However, if the Source
set
is not the same size as this one only
the overlapping part will be processed, the operation will not
resize
this set. </remarks>
}
procedure ExclusiveOr(Source: THugeSet); { A xor B }
{! <summary>
Perform a bitwise AND NOT operation on this and the passed Source
set.</summary>
<param name="Source">is the set to intersect this one with. Cannot
be nil.</param>
<exception cref="EParameterCannotBeNil">is raised if Source is
nil.</exception>
<remarks>
As a result this set will have all bits set that were originally
set
in it but not in the Source set. However, if the Source set is
smaller only
the overlapping part will be processed, any extra set bits will
remain
set.</remarks>
}
procedure Subtract(Source: THugeSet); { A and not B }
{! <summary>
Perform a bitwise NOT operation on this set. This flips the state
of
all bits.</summary>
}
procedure Invert; { not A }
{! <summary>
Create and return an exact copy of this set. </summary>
}
function Clone: THugeSet;
{! <summary>
Check whether an element is in the set.</summary>
<returns>true if the member is in the set (the bit is set), false
if it is not in the set (the bit is not set).</returns>
<param name="aElement">is the ordinal of the member check for set
membership.</param>
<exception cref="EHugeSetException">is raised if range checks are
on and aElement is not in the range 0 to MaxMember.</exception>
}
function Contains(aElement: Longint): Boolean;
{! <summary>
Set a range of bits to a certain state.</summary>
<param name="fromIndex">is the index of the first bit to
set</param>
<param name="toIndex">is the index of the last bit to set</param>
<param name="toValue">is the state of the bit to set.</param>
<exception cref="EHugeSetException">is raised if range checks are
on and an index is not in the range 0 to MaxMember.</exception>
<remarks>
If fromIndex is larger than toIndex the two are silently
swapped.</remarks>
}
procedure SetRange(fromIndex, toIndex: LongInt; toValue: Boolean);
{! <summary>
Enumerate all members of the set and call the passed callback for
each member found.</summary>
<param name="enumProc">is the callback to call, cannot be nil. The
callback can end the enumeration by returning false.</param>
<param name="lparam">is an caller-defined parameter that is passed
unchanged to the callback. Can be used to pass an object
reference,
for instance.</param>
<exception cref="EParameterCannotBeNil">is raised if enumProc is
nil.</exception>
}
procedure EnumBits(enumProc: TEnumBitsProc; lparam: LPARAM);
{: <summary>
Exclude a member from the set.</summary>
<exception cref="EHugeSetException">is raised if range checks are
on and an aElement is not in the range 0 to MaxMember.</exception>
}
procedure Exclude(aElement: Longint);
{: <summary>
Include a member in the set.</summary>
<exception cref="EHugeSetException">is raised if range checks are
on and an aElement is not in the range 0 to MaxMember.</exception>
}
procedure Include(aElement: Longint);
{! <value>
Returns the size of the internal storage in longwords.</value>
}
property Size: Cardinal read FSize;
{! <value>
Returns the ordinal of the largest set member allowed.</value>
}
property Max: LongInt read FMax;
{! <value>
Returns the count of set bits (elements in the set).</value>
}
property Count: LongInt read GetCount;
{! <value>
Get or set a bit in the set (test for presence of an element,
include or exclude an element). </value>
}
property Bits[index: LongInt]: Boolean
read GetBit write SetBit;
default;
end;
implementation
uses
CommonTypesU;
const
{$IFDEF GERMAN}
ESetCreate =
'Kann angeforderten Set nicht erzeugen, bei einem höchsten ' +
'Element von %d müßte er > 64 KByte sein!';
EIndexOutOfRange =
'Element %d außerhalb des erlaubten Bereiches! '#13#10 +
'Maximalwert ist %d.';
{$ELSE}
ESetCreate =
'Unable to create requested set. With a highest member of %d ' +
'it would have to be > 64 KByte!';
EIndexOutOfRange =
'Element %d out of range! Maximum allowed is %d.';
{$ENDIF}
var
XlatTable: packed array[Byte] of Byte;
procedure SetBits;
var
n: Byte;
function BitsSet(n: Byte): Byte;
type
BS = set of 0..7;
var
i: Byte;
begin (* BitsSet *)
Result := 0;
for i := 0 to 7 do
if i in BS(n) then
INC(Result);
end { BitsSet };
begin (* SetBits *)
for n := 0 to 255 do
XlatTable[n] := BitsSet(n);
end { SetBits };
function CountBits(p: Pointer; numBytes: Cardinal): LongInt; assembler;
asm
{P is in EAX, numBytes in EDX on entry, result is returned in EAX}
push edi
push ecx
push ebx
push edx
mov ebx, offset XLatTable { edx addresses bitcount table }
sub ecx, ecx { ecx is used as accumulator }
mov edi, eax { edi references the bytes to process
}
or edx, edx { anything to do? }
jz @done { if yes }
sub eax, eax { eax holds intermediate values }
@loop:
mov al, [edi] { get byte to process }
inc edi { address next byte }
xlat { lookup bit count }
add ecx, eax { add it to accumulator }
dec edx { decrement counter }
jnz @loop { repeat if more bytes to go }
@done:
mov eax, ecx { move result into eax }
pop edx
pop ebx
pop ecx
pop edi
end;
{== THugeSet ==========================================================}
constructor THugeSet.Create(highestMember: LongInt);
begin
if highestMember < 0 then
raise EInvalidParameter.Create('THugeSet.Create','highestMember has
to be >= 0.');
inherited Create;
CreateStorage(highestMember);
end; { THugeSet.Create }
destructor THugeSet.Destroy;
begin
if Fmem <> nil then
FreeMem(FMem, StorageSizeInBytes);
inherited Destroy;
end; { THugeSet.Destroy }
procedure THugeSet.SetBit(atIndex: LongInt; toValue: Boolean);
begin
{$IFOPT R+}
if (atIndex < 0) or (atIndex > FMax) then
raise EHugeSetException.CreateFmt(
EIndexOutOfRange,
[atIndex, FMax]);
{$ENDIF}
if toValue then
System.Include(FMem^[atIndex div BitsPerUnit], atIndex mod
BitsPerUnit)
else
System.Exclude(FMem^[atIndex div BitsPerUnit], atIndex mod
BitsPerUnit)
end; { THugeSet.SetBit }
function THugeSet.GetBit(atIndex: LongInt): Boolean;
begin
{$IFOPT R+}
if (atIndex < 0) or (atIndex > FMax) then
raise EHugeSetException.CreateFmt(
EIndexOutOfRange,
[atIndex, FMax]);
{$ENDIF}
Result := (atIndex mod BitsPerUnit) in FMem^[atIndex div
BitsPerUnit];
end; { THugeSet.GetBit }
function THugeSet.GetCount: LongInt;
begin
Result := CountBits(FMem, StoragesizeInBytes);
end; { THugeSet.GetCount }
procedure THugeSet.DefineProperties(Filer: TFiler);
begin
Filer.DefineBinaryProperty('Bits', ReadData, WriteData, true);
end; { THugeSet.DefineProperties }
procedure THugeSet.Clear;
begin
FillChar(FMem^, StoragesizeInBytes, 0);
end; { THugeSet.Clear }
procedure THugeSet.Assign(Source: TPersistent);
var
ToCopy: Cardinal;
begin
if not Assigned(Source) then
raise EParameterCannotBeNil.Create('THugeSet.Assign','Source');
if Source is THugeSet then begin
Clear;
ToCopy := ElementsToProcess(THugeSet(Source));
Move(THugeSet(Source).FMem^, FMem^, ToCopy * BytesPerUnit);
end { If }
else
inherited Assign(Source);
end; { THugeSet.Assign }
{WARNING! These assembler functions depends on FastCall convention
beeing
used! }
procedure MemOR(p1, p2: Pointer; numDWORDS: Cardinal); assembler;
asm
{On entry: eax = p1, edx = p2, ecx = numDWords}
pushad
mov ebx, eax
or ecx, ecx
jz @done
@loop:
mov eax,[edx]
or [ebx], eax
add edx, 4
add ebx, 4
dec ecx
jnz @loop
@done:
popad
end;
procedure MemAND(p1, p2: Pointer; numDWORDS: Cardinal); assembler;
asm
{On entry: eax = p1, edx = p2, ecx = numDWords}
pushad
mov ebx, eax
or ecx, ecx
jz @done
@loop:
mov eax,[edx]
and [ebx], eax
add edx, 4
add ebx, 4
dec ecx
jnz @loop
@done:
popad
end;
procedure MemXOR(p1, p2: Pointer; numDWORDS: Cardinal); assembler;
asm
{On entry: eax = p1, edx = p2, ecx = numDWords}
pushad
mov ebx, eax
or ecx, ecx
jz @done
@loop:
mov eax,[edx]
xor [ebx], eax
add edx, 4
add ebx, 4
dec ecx
jnz @loop
@done:
popad
end;
procedure MemANDNOT(p1, p2: Pointer; numDWORDS: Cardinal); assembler;
asm
{On entry: eax = p1, edx = p2, ecx = numDWords}
pushad
mov ebx, eax
or ecx, ecx
jz @done
@loop:
mov eax,[edx]
not eax
and [ebx], eax
add edx, 4
add ebx, 4
dec ecx
jnz @loop
@done:
popad
end;
procedure MemNOT(p1: Pointer; numDWORDS: Cardinal); assembler;
asm
{On entry: eax = p1, edx = numDWords}
pushad
or edx, edx
jz @done
mov ebx, $FFFFFFFF
@loop:
xor [eax], ebx
add eax, 4
dec edx
jnz @loop
@done:
popad
end;
function THugeSet.ElementsToProcess(Source: THugeSet): Cardinal;
begin
if Source.FSize > FSize then
Result := FSize
else
Result := Source.FSize;
end; { THugeSet.SetupPtrs }
procedure THugeSet.Merge(Source: THugeSet); { A or B }
begin
if not Assigned(Source) then
raise EParameterCannotBeNil.Create('THugeSet.Merge','Source');
MemOR(FMem, Source.FMem, ElementsToProcess(Source));
end; { THugeSet.Merge }
procedure THugeSet.Intersect(Source: THugeSet); { A and B }
begin
if not Assigned(Source) then
raise EParameterCannotBeNil.Create('THugeSet.Merge','Intersect');
MemAND(FMem, Source.FMem, ElementsToProcess(Source));
end; { THugeSet.Intersect }
procedure THugeSet.ExclusiveOr(Source: THugeSet); { A xor B }
begin
if not Assigned(Source) then
raise EParameterCannotBeNil.Create('THugeSet.Merge','ExclusiveOr');
MemXOR(FMem, Source.FMem, ElementsToProcess(Source));
end; { THugeSet.ExclusiveOr }
procedure THugeSet.Subtract(Source: THugeSet); { A and not B }
begin
if not Assigned(Source) then
raise EParameterCannotBeNil.Create('THugeSet.Merge','Subtract');
MemANDNOT(FMem, Source.FMem, ElementsToProcess(Source));
end; { THugeSet.Subtract }
procedure THugeSet.Invert; { not A }
begin
MemNOT(FMem, FSize);
end; { THugeSet.Invert }
function THugeSet.Clone: THugeSet;
begin
Result := THugeSet.Create(FMax);
Result.Assign(Self);
end; { THugeSet.Clone }
function THugeSet.Contains(aElement: Longint): Boolean;
begin
Result := GetBit(aElement);
end;
procedure THugeSet.CreateStorage(highestMember: LongInt);
begin
FMax := highestMember;
Inc(highestMember);
FSize := (highestMember div BitsPerUnit) +
Ord(highestMember mod BitsPerUnit <> 0);
FMem := AllocMem(StoragesizeInBytes);
end;
procedure THugeSet.SetRange(fromIndex, toIndex: LongInt; toValue:
Boolean);
var
i: LongInt;
begin
if fromIndex > toIndex then begin
i:= fromIndex;
fromIndex := toIndex;
toIndex := i;
end; {if}
for i := fromIndex to toIndex do
SetBit(i, toValue);
end; { THugeSet.SetRange }
procedure THugeSet.EnumBits(enumProc: TEnumBitsProc; lparam: LPARAM);
var
i: LongInt;
begin
if not Assigned(enumProc) then
raise EParameterCannotBeNil.Create(' THugeSet.EnumBits','enumProc');
for i := 0 to FMax do
if GetBit(i) then
if not enumProc(i, lparam) then
Exit;
end; { THugeSet.EnumBits }
procedure THugeSet.Exclude(aElement: Longint);
begin
SetBit(aElement, false);
end;
procedure THugeSet.Include(aElement: Longint);
begin
SetBit(aElement, true);
end;
procedure THugeSet.ReadData(Stream: TStream);
var
N: LongInt;
begin
Stream.ReadBuffer(N, Sizeof(N));
if N <> FMax then begin
if Assigned(FMem) then
FreeMem(FMem, StoragesizeInBytes);
CreateStorage(N);
end; {if}
Stream.ReadBuffer(FMem^, StoragesizeInBytes);
end;
function THugeSet.StorageSizeInBytes: LongInt;
begin
Result := FSize * BytesPerUnit;
end;
procedure THugeSet.WriteData(Stream: TStream);
begin
Stream.WriteBuffer(FMax, Sizeof(FMax));
Stream.WriteBuffer(FMem^, StoragesizeInBytes);
end;
initialization
SetBits;
end.
--
Peter Below
TeamB