{*
  Exemple de gestion d'un ensemble large au moyen de record avancé
  @author sjrd
  @version 1.0
*}
unit BigSetExample;

interface

uses
  SysUtils;

type
  /// Un type trop grand pour être mis dans un ensemble
  TBigValue = 0..450;

const
  /// Nombre de doubles-mots sur lesquels stocker un ensemble de TBigValue
  BigValueSetCount = (High(TBigValue) - Low(TBigValue)) div 32 + 1;

type
  {*
    Ensemble de TBigValue
    TBigValueSet contient un ensemble de valeurs de type TBigValue. Puisque ce
    type a une étendue trop grande pour être stocké dans un set du langage,
    TBigValueSet reproduit le fonctionnement de ces types ensemble au sein d'un
    tableau de bits.
    Si vous n'utilisez pas le constructeur, appelez la méthode Clear avant toute
    utilisation. Sinon, le contenu de l'ensemble est indéterminé.
    @author sjrd
    @version 1.0
  *}
  TBigValueSet = record
  private
    // Don't put any field before Contents: it must remain the first one!
    Contents: array[0..BigValueSetCount-1] of LongWord;

    function GetIsEmpty: Boolean;
  public
    constructor Create(const Values: array of TBigValue);

    procedure Clear;
    procedure Include(Value: TBigValue);
    procedure Exclude(Value: TBigValue);

    procedure Union(const Values: TBigValueSet);
    procedure Substract(const Values: TBigValueSet);
    procedure Intersect(const Values: TBigValueSet);

    class operator Add(const Left, Right: TBigValueSet): TBigValueSet;
    class operator Subtract(const Left, Right: TBigValueSet): TBigValueSet;
    class operator Multiply(const Left, Right: TBigValueSet): TBigValueSet;

    class operator Equal(const Left, Right: TBigValueSet): Boolean;
    class operator NotEqual(const Left, Right: TBigValueSet): Boolean;

    function Exists(Value: TBigValue): Boolean;

    property IsEmpty: Boolean read GetIsEmpty;
  end;

function BigValueSetToString(const Values: TBigValueSet): string;

implementation

{*
  Crée un nouvel ensemble de TBigValue à partir d'un tableau de TBigValue
  Chaque valeur présente au moins une fois dans le tableau fera partie de
  l'ensemble.
  @param Values   Tableau de valeurs de type TBigValue
*}
constructor TBigValueSet.Create(const Values: array of TBigValue);
var
  I: Integer;
begin
  Clear;
  for I := Low(Values) to High(Values) do
    Include(Values[I]);
end;

{*
  Indique si l'ensemble est vide
  @return True si l'ensemble est vide, False sinon
*}
function TBigValueSet.GetIsEmpty: Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := BigValueSetCount-1 downto 0 do
    if Contents[I] <> 0 then
      Exit;
  Result := True;
end;

{*
  Vide l'ensemble
*}
procedure TBigValueSet.Clear;
begin
  FillChar(Contents, SizeOf(Contents), 0);
end;

{*
  Ajoute une valeur dans l'ensemble, si elle n'y était pas encore
  @param Value   Valeur à ajouter
*}
procedure TBigValueSet.Include(Value: TBigValue);
asm
        { -> EAX        Address of the TBigValueSet record
             DX         Value to include                   }
        MOVZX   EDX,DX
        BTS     [EAX],EDX
end;

{*
  Retire une valeur de l'ensemble, si elle y était
  @param Value   Valeur à retirer
*}
procedure TBigValueSet.Exclude(Value: TBigValue);
asm
        { -> EAX        Address of the TBigValueSet record
             DX         Value to exclude                   }
        MOVZX   EDX,DX
        BTR     [EAX],EDX
end;

{*
  Ajoute à l'ensemble toutes les valeurs d'un autre ensemble (union)
  @param Values   Second ensemble
*}
procedure TBigValueSet.Union(const Values: TBigValueSet);
var
  I: Integer;
begin
  for I := BigValueSetCount-1 downto 0 do
    Contents[I] := Contents[I] or Values.Contents[I];
end;

{*
  Retire de l'ensemble toutes les valeurs d'un autre ensemble (soustraction)
  @param Values   Second ensemble
*}
procedure TBigValueSet.Substract(const Values: TBigValueSet);
var
  I: Integer;
begin
  for I := BigValueSetCount-1 downto 0 do
    Contents[I] := Contents[I] and not Values.Contents[I];
end;

{*
  Retire de l'ensemble toutes les valeurs non comprises dans un autre ensemble
  (intersection)
  @param Values   Second ensemble
*}
procedure TBigValueSet.Intersect(const Values: TBigValueSet);
var
  I: Integer;
begin
  for I := BigValueSetCount-1 downto 0 do
    Contents[I] := Contents[I] and Values.Contents[I];
end;

{*
  Opérateur + Calcule l'union de deux ensemble
  @param Left    Opérande de gauche
  @param Right   Opérande de droite
  @return Union de Left et Right
*}
class operator TBigValueSet.Add(const Left, Right: TBigValueSet): TBigValueSet;
var
  I: Integer;
begin
  for I := BigValueSetCount-1 downto 0 do
    Result.Contents[I] := Left.Contents[I] or Right.Contents[I];
end;

{*
  Opérateur - Calcule la soustraction de deux ensemble
  @param Left    Opérande de gauche
  @param Right   Opérande de droite
  @return Left moins Right, au sens ensembliste du terme
*}
class operator TBigValueSet.Subtract(
  const Left, Right: TBigValueSet): TBigValueSet;
var
  I: Integer;
begin
  for I := BigValueSetCount-1 downto 0 do
    Result.Contents[I] := Left.Contents[I] and not Right.Contents[I];
end;

{*
  Opérateur * Calcule l'intersection entre deux ensemble
  @param Left    Opérande de gauche
  @param Right   Opérande de droite
  @return Intersection entre Left et Right
*}
class operator TBigValueSet.Multiply(
  const Left, Right: TBigValueSet): TBigValueSet;
var
  I: Integer;
begin
  for I := BigValueSetCount-1 downto 0 do
    Result.Contents[I] := Left.Contents[I] and Right.Contents[I];
end;

{*
  Détermine si deux ensembles sont égaux
  @param Left    Opérande de gauche
  @param Right   Opérande de droite
  @return True si les ensembles sont égaux, False sinon
*}
class operator TBigValueSet.Equal(const Left, Right: TBigValueSet): Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := BigValueSetCount-1 downto 0 do
    if Left.Contents[I] <> Right.Contents[I] then
      Exit;
  Result := True;
end;

{*
  Détermine si deux ensembles sont différents
  @param Left    Opérande de gauche
  @param Right   Opérande de droite
  @return True si les ensembles sont différents, False sinon
*}
class operator TBigValueSet.NotEqual(const Left, Right: TBigValueSet): Boolean;
begin
  Result := not (Left = Right);
end;

{*
  Détermine si l'ensemble contient une valeur particulière
  @param Value   Valeur à tester
  @return True si l'ensemble contient Value, False sinon
*}
function TBigValueSet.Exists(Value: TBigValue): Boolean;
asm
        { -> EAX        Address of the TBigValueSet record
             DX         Value to test
          <- AL         Result                             }
        MOVZX   EDX,DX
        BT      [EAX],EDX
        SETB    AL
end;

{*
  Convertit un ensemble de TBigValue en chaîne de caractères
  @param Values   Ensemble de TBigValue
  @return Représentation Pascal de l'ensemble Values
*}
function BigValueSetToString(const Values: TBigValueSet): string;
var
  Value: TBigValue;
begin
  Result := '';
  for Value := Low(TBigValue) to High(TBigValue) do
    if Values.Exists(Value) then
      Result := Result + ' ' + IntToStr(Value) + ',';

  if Result <> '' then
  begin
    Result[1] := '[';
    Result[Length(Result)] := ']';
  end;
end;

end.