unit IntegerSets;

interface

uses
  SysUtils;

type
  {*
    Ensemble basique d'entiers
    Avant toute utilisation, il faut appeler Clear.
    @author sjrd
    @version 1.0
  *}
  TBasicIntSet = record
  private
    FItems: array of Integer; /// Éléments
    FCount: Integer;          /// Nombre d'éléments

    procedure Grow;
    function Find(Value: Integer; out Index: Integer): Boolean;

    function GetCapacity: Integer;
    function GetItems(Index: Integer): Integer;

    procedure SetCapacity(Value: Integer);
  public
    constructor Create(const Values: array of Integer);

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

    function Exists(Value: Integer): Boolean;

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

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

    property Count: Integer read FCount;
    property Capacity: Integer read GetCapacity write SetCapacity;
    property Items[Index: Integer]: Integer read GetItems; default;
  end;

function IntegerSetToString(const Values: TBasicIntSet): string;

implementation

{---------------------}
{ TBasicIntSet record }
{---------------------}

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

{*
  Agrandit le tableau interne
*}
procedure TBasicIntSet.Grow;
const
  AllocBy = 16;
  DoubleAt = 4*AllocBy;
var
  Len: Integer;
begin
  Len := Length(FItems);
  if Len < DoubleAt then
    SetLength(FItems, Len+AllocBy)
  else
    SetLength(FItems, 2*Len);
end;

{*
  Cherche la place d'une valeur dans le tableau interne
  @param Value   Valeur à chercher
  @param Index   Index où se trouve, ou où devrait se trouver, Value
  @return True si la valeur a été trouvée, False sinon
*}
function TBasicIntSet.Find(Value: Integer; out Index: Integer): Boolean;
var
  First, Last: Integer;
begin
  First := 0;
  Last := Count-1;

  while Last >= First do
  begin
    Index := (First+Last) div 2;

    if Value > FItems[Index] then
      First := Index+1
    else if Value < FItems[Index] then
      Last := Index-1
    else
    begin
      Result := True;
      Exit;
    end;
  end;

  Result := False;
  Index := First;
end;

{*
  Capacité du tableau interne
  @return Capacité du tableau interne
*}
function TBasicIntSet.GetCapacity: Integer;
begin
  Result := Length(FItems);
end;

{*
  Tableau zero-based des éléments contenus dans l'ensemble
  @param Index   Index d'un élément
  @return Valeur de l'élément désigné
*}
function TBasicIntSet.GetItems(Index: Integer): Integer;
begin
  Result := FItems[Index];
end;

{*
  Modifie la capacité du tableau interne
  @param Value   Nouvelle capacité
*}
procedure TBasicIntSet.SetCapacity(Value: Integer);
begin
  SetLength(FItems, Value);
  if FCount > Value then
    FCount := Value;
end;

{*
  Vide l'ensemble
*}
procedure TBasicIntSet.Clear;
begin
  SetLength(FItems, 0);
  FCount := 0;
end;

{*
  Ajoute une valeur dans l'ensemble, si elle n'y était pas encore
  @param Value   Valeur à ajouter
*}
procedure TBasicIntSet.Include(Value: Integer);
var
  Index: Integer;
begin
  if not Find(Value, Index) then
  begin
    if Count >= Length(FItems) then
      Grow;

    Move(FItems[Index], FItems[Index+1], (Count-Index)*SizeOf(Integer));
    FItems[Index] := Value;
    Inc(FCount);
  end;
end;

{*
  Retire une valeur de l'ensemble, si elle y était
  @param Value   Valeur à retirer
*}
procedure TBasicIntSet.Exclude(Value: Integer);
var
  Index: Integer;
begin
  if Find(Value, Index) then
  begin
    Dec(FCount);
    Move(FItems[Index+1], FItems[Index], (Count-Index)*SizeOf(Integer));

    if Count <= Length(FItems) div 4 then
      SetLength(FItems, Count*2);
  end;
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 TBasicIntSet.Exists(Value: Integer): Boolean;
var
  Temp: Integer;
begin
  Result := Find(Value, Temp);
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 TBasicIntSet.Add(const Left, Right: TBasicIntSet): TBasicIntSet;
var
  LeftIdx, RightIdx: Integer;
begin
  with Result do
  begin
    SetLength(FItems, Left.Count + Right.Count);
    FCount := 0;

    LeftIdx := 0;
    RightIdx := 0;

    while (LeftIdx < Left.Count) and (RightIdx < Right.Count) do
    begin
      if Left.FItems[LeftIdx] < Right.FItems[RightIdx] then
      begin
        FItems[FCount] := Left.FItems[LeftIdx];
        Inc(LeftIdx);
      end else if Left.FItems[LeftIdx] > Right.FItems[RightIdx] then
      begin
        FItems[FCount] := Right.FItems[RightIdx];
        Inc(RightIdx);
      end else
      begin
        FItems[FCount] := Left.FItems[LeftIdx];
        Inc(LeftIdx);
        Inc(RightIdx);
      end;

      Inc(FCount);
    end;

    while LeftIdx < Left.Count do
    begin
      FItems[FCount] := Left.FItems[LeftIdx];
      Inc(LeftIdx);
      Inc(FCount);
    end;

    while RightIdx < Right.Count do
    begin
      FItems[FCount] := Right.FItems[RightIdx];
      Inc(RightIdx);
      Inc(FCount);
    end;
  end;
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 TBasicIntSet.Subtract(
  const Left, Right: TBasicIntSet): TBasicIntSet;
var
  LeftIdx, RightIdx, Value: Integer;
begin
  with Result do
  begin
    SetLength(FItems, Left.Count);
    FCount := 0;

    LeftIdx := 0;
    RightIdx := 0;

    while (LeftIdx < Left.Count) and (RightIdx < Right.Count) do
    begin
      Value := Left.FItems[LeftIdx];
      Inc(LeftIdx);

      while (RightIdx < Right.Count) and (Right.FItems[RightIdx] < Value) do
        Inc(RightIdx);

      if (RightIdx >= Right.Count) or (Right.FItems[RightIdx] <> Value) then
      begin
        FItems[FCount] := Value;
        Inc(FCount);
      end;
    end;

    while LeftIdx < Left.Count do
    begin
      FItems[FCount] := Left.FItems[LeftIdx];
      Inc(LeftIdx);
      Inc(FCount);
    end;
  end;
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 TBasicIntSet.Multiply(
  const Left, Right: TBasicIntSet): TBasicIntSet;
var
  LeftIdx, RightIdx: Integer;
begin
  with Result do
  begin
    if Left.Count < Right.Count then
      SetLength(FItems, Left.Count)
    else
      SetLength(FItems, Right.Count);
    FCount := 0;

    LeftIdx := 0;
    RightIdx := 0;

    while (LeftIdx < Left.Count) and (RightIdx < Right.Count) do
    begin
      if Left.FItems[LeftIdx] < Right.FItems[RightIdx] then
        Inc(LeftIdx)
      else if Left.FItems[LeftIdx] > Right.FItems[RightIdx] then
        Inc(RightIdx)
      else
      begin
        FItems[FCount] := Left.FItems[LeftIdx];
        Inc(LeftIdx);
        Inc(RightIdx);
        Inc(FCount);
      end;
    end;
  end;
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 TBasicIntSet.Equal(const Left, Right: TBasicIntSet): Boolean;
var
  I: Integer;
begin
  Result := False;

  if Left.Count <> Right.Count then
    Exit;
  for I := 0 to Left.Count-1 do
    if Left.FItems[I] <> Right.FItems[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 TBasicIntSet.NotEqual(const Left, Right: TBasicIntSet): Boolean;
begin
  Result := not (Left = Right);
end;

{*
  Convertit un ensemble d'entiers en chaîne de caractères
  @param Values   Ensemble d'entiers
  @return Représentation Pascal de l'ensemble Values
*}
function IntegerSetToString(const Values: TBasicIntSet): string;
var
  I: Integer;
begin
  Result := '';

  if Values.Count > 0 then
  begin
    for I := 0 to Values.Count-1 do
      Result := Result + ' ' + IntToStr(Values.Items[I]) + ',';

    Result[1] := '[';
    Result[Length(Result)] := ']';
  end;
end;

end.