home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue52 / Alfresco / AABitSet.pas next >
Encoding:
Pascal/Delphi Source File  |  1999-10-31  |  7.5 KB  |  257 lines
  1. {*********************************************************}
  2. {* AABitSet                                              *}
  3. {* Copyright (c) Julian M Bucknall 1999                  *}
  4. {* All rights reserved.                                  *}
  5. {*********************************************************}
  6. {* Algorithms Alfresco bitset                            *}
  7. {*********************************************************}
  8.  
  9. {Note: this unit is released as freeware. In other words, you are free
  10.        to use this unit in your own applications, however I retain all
  11.        copyright to the code. JMB}
  12.  
  13. unit AABitSet;
  14.  
  15. interface
  16.  
  17. uses
  18.   SysUtils;
  19.  
  20. type
  21.   {$IFDEF Windows}
  22.   TaaMemSizeType = word;
  23.   {$ELSE}
  24.   TaaMemSizeType = integer;
  25.   {$ENDIF}
  26.  
  27.   TaaBitSet = class
  28.     private
  29.       FBitArray     : PByteArray;
  30.       FBitArraySize : TaaMemSizeType;
  31.       FBitCount     : longint;
  32.       FSetBitCount  : longint;
  33.     protected
  34.       function bsGetBit(aIndex : longint) : boolean;
  35.       procedure bsSetBit(aIndex : longint; aValue : boolean);
  36.  
  37.       procedure bsRecountSetBits;
  38.     public
  39.       constructor Create(aBitCount : longint);
  40.       destructor Destroy; override;
  41.  
  42.       procedure ClearAllBits;
  43.         {-clear all bits}
  44.       procedure SetAllBits;
  45.         {-set all bits}
  46.  
  47.       function GetNextBit : longint;
  48.         {-find a false bit, set it true, and return its index}
  49.  
  50.       procedure AndBitSet(aBitSet : TaaBitSet);
  51.         {-AND the given bitset with ours}
  52.       procedure NotBitSet;
  53.         {-NOT all bits in our bitset}
  54.       procedure OrBitSet(aBitSet : TaaBitSet);
  55.         {-OR the given bitset with ours}
  56.       procedure XorBitSet(aBitSet : TaaBitSet);
  57.         {-XOR the given bitset with ours}
  58.  
  59.       property Bits[aIndex : longint] : boolean
  60.          read bsGetBit write bsSetBit; default;
  61.  
  62.       property BitCount : longint read FBitCount;
  63.       property SetBitCount : longint read FSetBitCount;
  64.   end;
  65.  
  66. implementation
  67.  
  68. {====================================================================}
  69. constructor TaaBitSet.Create(aBitCount : longint);
  70. begin
  71.   inherited Create;
  72.   if (aBitCount <= 0) then
  73.     raise Exception.Create('TaaBitSet.Create: The number of bits must be greater than zero');
  74.   {$IFDEF Windows}
  75.   if (aBitCount > 524000) then
  76.     raise Exception.Create('TaaBitSet.Create: In Delphi 1, the number of bits must be less than 524000');
  77.   {$ENDIF}
  78.   FBitArraySize := (aBitCount + 7) div 8;
  79.   FBitCount := aBitCount;
  80.   FBitArray := AllocMem(FBitArraySize);
  81. end;
  82. {--------}
  83. destructor TaaBitSet.Destroy;
  84. begin
  85.   if (FBitArray <> nil) then begin
  86.     FreeMem(FBitArray, FBitArraySize);
  87.     FBitArray := nil;
  88.   end;
  89.   inherited Destroy;
  90. end;
  91. {--------}
  92. procedure TaaBitSet.AndBitSet(aBitSet : TaaBitSet);
  93. var
  94.   i : longint;
  95. begin
  96.   if (BitCount <> aBitSet.BitCount) then
  97.     raise Exception.Create('TaaBitSet.AndBitSet: The bitsets must have the same number of bits');
  98.   for i := 0 to pred(FBitArraySize) do
  99.     FBitArray^[i] := FBitArray^[i] and aBitSet.FBitArray^[i];
  100.   bsRecountSetBits;
  101. end;
  102. {--------}
  103. function TaaBitSet.bsGetBit(aIndex : longint) : boolean;
  104. var
  105.   BytePtr : ^byte;
  106.   Mask    : byte;
  107. begin
  108.   BytePtr := @FBitArray^[aIndex div 8];
  109.   Mask := 1 shl (aIndex mod 8);
  110.   Result := (BytePtr^ and Mask) <> 0;
  111. end;
  112. {--------}
  113. procedure TaaBitSet.bsRecountSetBits;
  114. const
  115.   BitsPerByte : array [byte] of byte = (
  116.      0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4,
  117.      1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
  118.      1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
  119.      2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
  120.      1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
  121.      2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
  122.      2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
  123.      3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
  124.      1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
  125.      2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
  126.      2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
  127.      3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
  128.      2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
  129.      3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
  130.      3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
  131.      4, 5, 5, 6, 5, 6, 6, 7, 5, 6, 6, 7, 6, 7, 7, 8);
  132. var
  133.   i         : TaaMemSizeType;
  134.   NewCount  : longint;
  135.   FullBytes : TaaMemSizeType;
  136. begin
  137.   {do the easy count first}
  138.   NewCount := 0;
  139.   FullBytes := BitCount div 8;
  140.   for i := 0 to pred(FullBytes) do
  141.     inc(NewCount, BitsPerByte[FBitArray^[i]]);
  142.   {now count the last 1 to 7 booleans}
  143.   for i := (FullBytes * 8) to pred(BitCount) do
  144.     if Bits[i] then
  145.       inc(NewCount);
  146.   FSetBitCount := NewCount;
  147. end;
  148. {--------}
  149. procedure TaaBitSet.bsSetBit(aIndex : longint; aValue : boolean);
  150. var
  151.   BytePtr : ^byte;
  152.   Mask    : byte;
  153. begin
  154.   BytePtr := @FBitArray^[aIndex div 8];
  155.   Mask := 1 shl (aIndex mod 8);
  156.   if aValue then begin
  157.     if ((BytePtr^ and Mask) = 0) then
  158.       inc(FSetBitCount);
  159.     BytePtr^ := BytePtr^ or Mask;
  160.   end
  161.   else begin
  162.     if ((BytePtr^ and Mask) <> 0) then
  163.       dec(FSetBitCount);
  164.     BytePtr^ := BytePtr^ and (not Mask);
  165.   end;
  166. end;
  167. {--------}
  168. procedure TaaBitSet.ClearAllBits;
  169. begin
  170.   FillChar(FBitArray^, FBitArraySize, 0);
  171.   FSetBitCount := 0;
  172. end;
  173. {--------}
  174. function TaaBitSet.GetNextBit : longint;
  175. var
  176.   i       : TaaMemSizeType;
  177.   ByteInx : longint;
  178.   FullBytes : TaaMemSizeType;
  179.   OurByte : byte;
  180.   Mask    : byte;  
  181. begin
  182.   {first find a byte that's not $FF, excluding the last byte; this
  183.    means that byte has clear bits}
  184.   ByteInx := -1;
  185.   FullBytes := BitCount div 8;
  186.   for i := 0 to pred(FullBytes) do
  187.     if (FBitArray^[i] <> $FF) then begin
  188.       ByteInx := i;
  189.       Break;
  190.     end;
  191.   {if we found a byte, then work out the index of the bit that's free}
  192.   if (ByteInx <> -1) then begin
  193.     Mask := 1;
  194.     OurByte := FBitArray^[ByteInx];
  195.     for i := 0 to 7 do begin
  196.       if ((OurByte and Mask) = 0) then begin
  197.         Result := (ByteInx * 8) + i;
  198.         FBitArray^[ByteInx] := FBitArray^[ByteInx] or Mask;
  199.         inc(FSetBitCount);
  200.         Exit;
  201.       end;
  202.       Mask := Mask * 2;
  203.     end;
  204.   end
  205.   {otherwise check the 1-7 bits in the final byte}
  206.   else begin
  207.     for i := (FullBytes * 8) to pred(BitCount) do
  208.       if not Bits[i] then begin
  209.         Result := i;
  210.         Bits[i] := true;
  211.         Exit;
  212.       end;
  213.   end;
  214.   {we failed to find a clear bit}
  215.   Result := -1;
  216. end;
  217. {--------}
  218. procedure TaaBitSet.NotBitSet;
  219. var
  220.   i : integer;
  221. begin
  222.   for i := 0 to pred(FBitArraySize) do
  223.     FBitArray^[i] := not FBitArray^[i];
  224.   FSetBitCount := BitCount - FSetBitCount;
  225. end;
  226. {--------}
  227. procedure TaaBitSet.OrBitSet(aBitSet : TaaBitSet);
  228. var
  229.   i : longint;
  230. begin
  231.   if (BitCount <> aBitSet.BitCount) then
  232.     raise Exception.Create('TaaBitSet.OrBitSet: The bitsets must have the same number of bits');
  233.   for i := 0 to pred(FBitArraySize) do
  234.     FBitArray^[i] := FBitArray^[i] or aBitSet.FBitArray^[i];
  235.   bsRecountSetBits;
  236. end;
  237. {--------}
  238. procedure TaaBitSet.SetAllBits;
  239. begin
  240.   FillChar(FBitArray^, FBitArraySize, $FF);
  241.   FSetBitCount := FBitCount;
  242. end;
  243. {--------}
  244. procedure TaaBitSet.XorBitSet(aBitSet : TaaBitSet);
  245. var
  246.   i : longint;
  247. begin
  248.   if (BitCount <> aBitSet.BitCount) then
  249.     raise Exception.Create('TaaBitSet.XorBitSet: The bitsets must have the same number of bits');
  250.   for i := 0 to pred(FBitArraySize) do
  251.     FBitArray^[i] := FBitArray^[i] xor aBitSet.FBitArray^[i];
  252.   bsRecountSetBits;
  253. end;
  254. {====================================================================}
  255.  
  256. end.
  257.