unit dyBigSet;

// La classe TdyBigSet héberge et manipule de grands ensembles :
// l'objet stocke et gère un ensemble de cardinaux qui s'étendent
// de 0 à Capacity-1, stockés 8 par octet, grâce aux champs de bits.
// Un ensemble de 65536 éléments (High(Word)+1) occupe donc environ 8 Ko.
// made in tourlourou, 12/01/2008, adapté d'une unité de sjrd (developpez.com) :
{*
  unit BigSetExample;
  Exemple de gestion d'un ensemble large au moyen de record avancé
  @author sjrd
  @version 1.0
*}

interface

uses
  SysUtils, Classes, Math;

const
  MaxCapacity     = $01000000; // arbitraire (stockage sur 2 Mo)
  DefaultCapacity = $00010000; // 65536 éléments (soit 8 Ko)

type
  Str30=string[30];
  TCardTab=array of Cardinal;

type
  TdyBigSet=class
  private
    PContents: array of Cardinal;       // ne rien modifier dans les déclarations,
    FCapa: Cardinal;                    // et ne surtout pas ajouter de champ avant
    FElements: Cardinal;                // pour ne pas décaler les offsets des champs
    FHighest: Cardinal;                 // par rapport à l'adresse de l'objet (EAX=self)
    FTabLen: Cardinal;
    FContentSize: Cardinal;
    FVarCap: Boolean;
    FHighMask: Cardinal;                // masque des bits non utilisés du dernier Cardinal
    FName: Str30;
    procedure FError(AType: Cardinal);
    function CompteElements: Cardinal;
    procedure SetCapa(AValue: Cardinal);
    function GetValues: TCardTab;
  public
    constructor Create(AName: Str30; ACapacity: Cardinal = DefaultCapacity); overload;
    constructor FileCreate(AFileName: string);
    destructor Destroy; override;
    procedure Clear;
    procedure Include(AValue: Cardinal);
    procedure Exclude(AValue: Cardinal);
    procedure SetValues(AValues: array of Cardinal);
    procedure AddValues(AValues: array of Cardinal);
    procedure SupprValues(AValues: array of Cardinal);
    function IsEmpty: Boolean;
    function IsFull: Boolean;
    function IsInSet(AValue: Cardinal): Boolean;
    function AreInSet(AValues: array of Cardinal): Boolean;
    function Equals(ABigSet: TdyBigSet; StrictEquality: Boolean = False): Boolean; // True pour tester l'identité
    procedure Union(ABigSet: TdyBigSet);                                           // des contenus et des capacités
    procedure Substract(ABigSet: TdyBigSet);
    procedure Intersect(ABigSet: TdyBigSet);
    procedure SaveToStream(AStream: TStream);
    procedure LoadFromStream(AStream: TStream);
    procedure SaveToFile(AFileName: string);
    procedure LoadFromFile(AFileName: string);
  property Name: Str30 read FName;
  property Elements: Cardinal read FElements;                       // nombre d'éléments présents dans l'ensemble
  property Capacity: Cardinal read FCapa write SetCapa;             // capacité de l'ensemble ( en nombre d'éléments)
  property VariableCapacity: Boolean read FVarCap write FVarCap;    // True si on peut modifier la taille de l'ensemble
  property Values: TCardTab read GetValues;                // renvoie les valeurs contenues dans l'ensemble
  end;

implementation

const
  ecTooElts = 0;
  ecSupMaxi = 1;
  ecOverCap = 2;
  ecDiffCap = 3;
  ecFixeCap = 4;
  ecOverSiz = 5;
  ErrStr: array[ecTooElts..ecOverSiz] of string
   = ( ('Trop d''éléments pour l''ensemble'),
       ('Valeur trop grande, hors de l''ensemble'),
       ('Dépassement de la capacité de l''ensemble'),
       ('Capacité de la sauvegarde différente'),
       ('Ensemble de taille fixe'),
       ('Taille d''ensemble trop grande') );

const
  ofsPCon =  4;
  ofsFCap =  8;
  ofsFElt = 12;
  ofsHigh = 16;

procedure TdyBigSet.FError(AType: Cardinal);
begin
  raise Exception.Create(ErrStr[AType]);
end;

function TdyBigSet.CompteElements: Cardinal;
function BitSum(ACard: Cardinal): Cardinal;
  asm
    MOV Result, 0   // Result:=0;
    PUSH ECX        // sauvegarde ECX
    MOV ECX, 31     // initialisation compteur
  @BOUCLE:          // parcours des bits
    BT ACard, ECX   // copie le ECXième bit du Cardinal dans CF
    ADC Result, 0   // ajoute CF au résultat
    JECXZ @FIN      // fini si ECX vaut 0
    DEC ECX         // sinon recule d'un bit
    JMP @BOUCLE     // et boucle
  @FIN:             // sortie
    POP ECX         // restaure ECX
  end;
var
  i,c: Cardinal;
begin
  Result:=0;
  for i:=0 to FHighest
  do begin
    c:=PContents[i];
    if c>0 then Inc(Result, BitSum(c));
  end;
end;

procedure TdyBigSet.SetCapa(AValue: Cardinal);
var
  c,i: Cardinal;
begin
  if not FVarCap then FError(ecFixeCap);
  if AValue>MaxCapacity then FError(ecOverSiz);
  FHighMask:=0;
  FHighest:=AValue div 32;
  c:=AValue mod 32;
  if c=0
  then Dec(FHighest)
  else for i:=1 to c do begin
    FHighMask:= FHighMask shl 1;
    Inc(FHighMask);
  end;
  FTabLen:=FHighest+1;
  SetLength(PContents, FTabLen);
  if FTabLen>0 then PContents[FHighest]:=PContents[FHighest] and FHighMask;
  FContentSize:=4*FTabLen;
  if AValue<FCapa then FElements:=CompteElements;
  FCapa:=AValue;
end;

constructor TdyBigSet.Create(AName: Str30; ACapacity: Cardinal = DefaultCapacity);
var
  c,i: Cardinal;
begin
  if ACapacity>MaxCapacity then FError(ecOverSiz);
  inherited Create;
  FName:=AName;
  FVarCap:=True;
  SetCapa(ACapacity);
  FVarCap:=False; // par défaut
  Clear;
end;

constructor TdyBigSet.FileCreate(AFileName: string);
var
  tms: TMemoryStream;
begin
  self:=TdyBigSet.Create('', 0);
  FVarCap:=True;
  try
    tms:=TMemoryStream.Create;
    tms.LoadFromFile(AFileName);
    tms.Position:=0;
    LoadFromStream(tms);
  finally
    tms.Free;
    FVarCap:=False;
  end;
end;

destructor TdyBigSet.Destroy;
begin
  try
    SetLength(PContents, 0);
  except
    Finalize(PContents);
  end;
  inherited;
end;

procedure TdyBigSet.Clear;
var
  i: integer;
begin
  for i:=FHighest downto 0
  do PContents[i]:=0;
  FElements:=0;
end;

procedure TdyBigSet.Include(AValue: Cardinal);
asm
  CMP EDX, DWORD PTR [EAX+ofsFCap] // compare AValue (passé dans EDX) à self.Data.FCapa
  JB @SUITE                        // si inférieur, continue le traitement, sinon lève une erreur
// **** traitement en cas d'erreur ****
  MOV EDX, ecSupMaxi               // positionne la cause de l'erreur
  CALL FError                      // appelle la procédure de levée d'erreur
// ************************************
@SUITE:
  PUSH ECX                         // sauvegarde ECX
  MOV ECX, [EAX+ofsPCon]           // copie l'adresse du tableau dynamique dans ECX
  BTS [ECX], EDX                   // copie le EDXième bit de self.Data.PContents^ dans CF puis le positionne à 1
  JC @FIN                          // s'il était présent (test Carry Flag) : fini
  INC DWORD PTR [EAX+ofsFElt]      // sinon, incrémente self.Data.FElements
@FIN:
  POP ECX                          // restaure ECX
end;

procedure TdyBigSet.Exclude(AValue: Cardinal);
asm
  CMP EDX, DWORD PTR [EAX+ofsFCap] // compare AValue (passé dans EDX) à self.Data.FCapa
  JB @SUITE                        // si inférieur, continue le traitement, sinon lève une erreur
// **** traitement en cas d'erreur ****
  MOV EDX, ecSupMaxi               // positionne la cause de l'erreur
  CALL FError                      // appelle la procédure de levée d'erreur
// ************************************
@SUITE:
  PUSH ECX                         // sauvegarde ECX
  MOV ECX, [EAX+ofsPCon]           // copie l'adresse du tableau dynamique dans ECX
  BTR [ECX], EDX                   // copie le EDXième bit de self.Data.PContents^ dans CF puis le positionne à 0
  JNC @FIN                         // s'il était présent (test Carry Flag) : fini
  DEC DWORD PTR [EAX+ofsFElt]      // sinon, incrémente self.Data.FElements
@FIN:
  POP ECX                          // restaure ECX
end;

function TdyBigSet.IsInSet(AValue: Cardinal): Boolean;
asm
  MOV Result, 0                    // Result:=False
  CMP EDX, DWORD PTR [EAX+ofsFCap] // compare AValue (passé dans EDX) à self.Data.FCapa
  JB @SUITE                        // si inférieur, continue le traitement, sinon lève une erreur
// **** traitement en cas d'erreur ****
  MOV EDX, ecSupMaxi               // positionne la cause de l'erreur
  CALL FError                      // appelle la procédure de levée d'erreur
// ************************************
@SUITE:
  PUSH ECX                         // sauvegarde ECX
  MOV ECX, [EAX+ofsPCon]           // copie l'adresse du tableau dynamique dans ECX
  BT [ECX], EDX                    // copie le EDXième bit de self.Data.PContents^ dans CF
  ADC Result, 0                    // résultat = CF (Add with Carry)
  POP ECX                          // restaure ECX
end;

procedure TdyBigSet.SetValues(AValues: array of Cardinal);
begin
  Clear;
  AddValues(AValues);
end;

procedure TdyBigSet.AddValues(AValues: array of Cardinal);
var
  i: integer;
begin
  if Length(AValues)<=FCapa
  then for i:=Low(AValues) to High(AValues) do Include(AValues[i])
  else FError(ecTooElts);
end;  

procedure TdyBigSet.SupprValues(AValues: array of Cardinal);
var
  i: integer;
begin
  if Length(AValues)<=FCapa
  then for i:=Low(AValues) to High(AValues) do Exclude(AValues[i])
  else FError(ecTooElts);
end;

function TdyBigSet.IsEmpty: Boolean;
begin
  Result:=(FElements=0);
end;

function TdyBigSet.IsFull: Boolean;
begin
  Result:=(FElements=FCapa);
end;

function TdyBigSet.AreInSet(AValues: array of Cardinal): Boolean;
var
  i: integer;
begin
  if Length(AValues)<=FCapa
  then for i:=Low(AValues) to High(AValues) do
  begin
    Result:=IsInSet(AValues[i]);
    if not Result then Exit;
  end
  else FError(ecTooElts);
end;

function TdyBigSet.Equals(ABigSet: TdyBigSet; StrictEquality: Boolean = False): Boolean;
var
  i: integer;
  Maxi: Cardinal;
begin
  Result:=False;
  if FElements<>ABigSet.FElements then Exit;
  if StrictEquality and (FCapa<>ABigSet.FCapa) then Exit;
  Maxi:=Min(FHighest, ABigSet.FHighest);
  for i:=Maxi downto 0 do
  try
    Result := ( PContents[i] = ABigSet.PContents[i] );
    if not Result then Exit;
  except
    FError(i);
  end;
end;

procedure TdyBigSet.Union(ABigSet: TdyBigSet);
var
  i: integer;
  Maxi: Cardinal;
begin
  if (ABigSet.FCapa>FCapa) and FVarCap
  then SetCapa(ABigSet.FCapa);
  Maxi:=Min(FCapa, ABigSet.FCapa);
  for i:=(Maxi div 32) downto 0
  do PContents[i]:=PContents[i] or ABigSet.PContents[i];
  PContents[FHighest]:=PContents[FHighest] and FHighMask;
  FElements:=CompteElements;
  if not FVarCap and (ABigSet.FCapa>FCapa)
  then FError(ecOverCap);
end;

procedure TdyBigSet.Substract(ABigSet: TdyBigSet);
var
  i: integer;
  Maxi: Cardinal;
begin
  Maxi:=Min(FCapa, ABigSet.FCapa);
  for i:=(Maxi div 32) downto 0
  do PContents[i]:=(PContents[i] and not ABigSet.PContents[i]);
  PContents[FHighest]:=PContents[FHighest] and FHighMask;
  FElements:=CompteElements;
end;


procedure TdyBigSet.Intersect(ABigSet: TdyBigSet);
var
  i: integer;
  Mini, Maxi: Cardinal;
begin
  Mini:=Min(FCapa, ABigSet.FCapa);
  Maxi:=Max(FCapa, ABigSet.FCapa);
  Maxi:=Min(Maxi, FCapa);
  for i:=(Maxi div 32) downto (Mini div 32)+1
  do PContents[i]:=0;
  for i:=(Mini div 32) downto 0
  do PContents[i]:=(PContents[i] and ABigSet.PContents[i]);
  PContents[FHighest]:=PContents[FHighest] and FHighMask;  
  FElements:=CompteElements;
end;

procedure TdyBigSet.SaveToStream(AStream: TStream);
var
  i: integer;
begin
  AStream.Write(FName, SizeOf(FName));
  AStream.Write(FElements, 4);
  AStream.Write(FCapa, 4);
  for i:=0 to FHighest
  do AStream.Write(PContents[i], 4);
end;

procedure TdyBigSet.LoadFromStream(AStream: TStream);
var
  Name: Str30;
  i: integer;
  Elts,Max: Cardinal;
begin
  Clear;
  AStream.Read(Name, SizeOf(FName));
  AStream.Read(Elts, 4);
  AStream.Read(Max, 4);
  if FCapa<>Max
  then begin
    if FVarCap
    then SetCapa(Max)
    else FError(ecDiffCap);
  end;
  FName:=Name;
  FElements:=Elts;
  for i:=0 to FHighest
  do AStream.Read(PContents[i], 4);
end;

procedure TdyBigSet.SaveToFile(AFileName: string);
var
  tms: TMemoryStream;
begin
  try
    tms:=TMemoryStream.Create;
    SaveToStream(tms);
    tms.SaveToFile(AFileName);
  finally
    tms.Free;
  end;
end;

procedure TdyBigSet.LoadFromFile(AFileName: string);
var
  tms: TMemoryStream;
  VarCap: Boolean;
begin
  VarCap:=FVarCap;
  FVarCap:=True;
  SetCapa(0);
  try
    tms:=TMemoryStream.Create;
    tms.LoadFromFile(AFileName);
    tms.Position:=0;
    LoadFromStream(tms);
  finally
    tms.Free;
    FVarCap:=VarCap;;
  end;
end;

function TdyBigSet.GetValues: TCardTab;
var
  i,e,j: integer;
  c,m: Cardinal;
begin
  SetLength(Result, FElements);
  if IsEmpty then Exit;
  i:=0;
  e:=0;
  repeat
    c:=PContents[i];
    if c>0
    then begin
      for j:=0 to 31
      do begin
        m:=1 shl j;
        if (c and m) = m
        then begin
          Result[e]:=32*i+j;
          Inc(e);
          if e=FElements then Exit;
        end;
      end;
    end;
    Inc(i);
  until i=FTabLen;
end;

end.