ezdslhsh.pas

Eazy Data Structures library for Delphi.

{===EZDSLHSH==========================================================

Part of the EZ Delphi Structures Library--the hash table

EZDSLHSH is Copyright (c) 1997-2002 by Julian M. Bucknall

VERSION HISTORY
12Feb02 JMB 3.03 Release for Delphi 6
24Oct99 JMB 3.02 Release for Delphi 4 & 5
14May98 JMB 3.01 Fix to mod in htlHash method
19Apr98 JMB 3.00 Initial release
=====================================================================}
{ Copyright (c) 1993-2002, Julian M. Bucknall. All Rights Reserved   }

unit EZDSLHsh;

{$I EzdslDef.inc}
{---Place any compiler options you require here----------------------}


{--------------------------------------------------------------------}
{$I EzdslOpt.inc}

interface

uses
  SysUtils,
  {$IFDEF Windows}
  WinTypes,
  WinProcs,
  {$ENDIF}
  {$IFDEF Win32}
  Windows,
  {$ENDIF}
  {$IFDEF Linux}
  Types,
  Libc,
  {$ENDIF}
  Classes,
  {$IFDEF ThreadsExist}
  EzdslThd,
  {$ENDIF}
  EzdslCts,
  EzdslSup,
  EzdslBse,
  EzdslLst;

type
  THashFunction = function (const S : string) : longint;

type
  THashTable = class(TAbstractContainer)
    {-Hash table}
    private
      htlArray     : pointer;
      htlHashFunc  : THashFunction;
      htlIgnoreCase: boolean;
      htlTableSize : integer;

    protected
      procedure htlSetHashFunction(HF : THashFunction);
      procedure htlSetIgnoreCase(IC : boolean);
      procedure htlSetTableSize(aNewTableSize : integer);

      procedure htlDeletePrim(const aKey : string; AndErase : boolean);
      function htlFindPrim(const aKey : string; var aIndex : integer) : boolean;
      procedure htlGrowTable;
      function htlHash(const aKey : string) : integer;
      procedure htlMakeNewTable(aNewTableSize : integer);
      procedure htlShrinkTable;

    public
      constructor Create(DataOwner  : boolean); override;
      destructor Destroy; override;

      constructor Clone(Source : TAbstractContainer;
                        DataOwner : boolean; NewCompare : TCompareFunc); override;

      procedure Delete(const aKey : string);
      procedure Empty; override;
      procedure Erase(const aKey : string);
      function Examine(const aKey : string) : pointer;
      procedure Insert(const aKey : string; aData : pointer);
      function Iterate(Action : TIterator; Backwards : boolean;
                        ExtraData : pointer) : pointer;
      procedure Join(HashTable : THashTable);
      function Search(const aKey : string; var aData : pointer) : boolean;

      property HashFunction : THashFunction read htlHashFunc write htlSetHashFunction;
      property IgnoreCase : boolean read htlIgnoreCase write htlSetIgnoreCase;
      property TableSize : integer read htlTableSize write htlSetTableSize;
  end;

{$IFDEF ThreadsExist}
type
  TThreadsafeHashTable = class
    protected {private}
      htHashTable : THashTable;
      htResLock  : TezResourceLock;
    protected
    public
      constructor Create(aDataOwner : boolean);
      destructor Destroy; override;

      function AcquireAccess : THashTable;
      procedure ReleaseAccess;
  end;
{$ENDIF}

{---various hashes---}
function HashELF(const S : string) : longint;
function HashPJW(const S : string) : longint;
function HashBKDR(const S : string) : longint;

implementation

const
  MinTableSize = 11;   {arbitrary smallest table size}
  StartTableSize = 53; {arbitrary beginning table size}

type
  THashElementState = (hesEmpty, hesDeleted, hesInUse);

  THashElement = packed record
    {$IFDEF Windows}
    heString : PString;
    {$ELSE}
    heString : string;
    {$ENDIF}
    heData   : pointer;
    heState  : THashElementState;
    heFiller : array [0..2] of byte;
  end;

  PHashElementArray = ^THashElementArray;
  THashElementArray =
     array [0..pred(MaxInt div sizeof(THashElement))] of THashElement;


{===Helper routines==================================================}
function GetClosestPrime(N : longint) : longint;
{$I EZPrimes.inc}
const
  Forever = true;
var
  L, R, M : integer;
  RootN   : longint;
  IsPrime : boolean;
  DivisorIndex : integer;
begin
  {treat 2 as a special case}
  if (N = 2) then begin
    Result := N;
    Exit;
  end;
  {make the result equal to N, and if it's even, the next odd number}
  if Odd(N) then
    Result := N
  else
    Result := succ(N);
  {if the result is within our prime number table, use binary search
   to find the equal or next highest prime number}
  if (Result <= MaxPrime) then begin
    L := 0;
    R := pred(PrimeCount);
    while (L <= R) do begin
      M := (L + R) div 2;
      if (Result = Primes[M]) then
        Exit
      else if (Result < Primes[M]) then
        R := pred(M)
      else
        L := succ(M);
    end;
    Result := Primes[L];
    Exit;
  end;
  {the result is outside our prime number table range, use the
   standard method for testing primality (do any of the primes up to
   the root of the number divide it exactly?) and continue
   incrementing the result by 2 until it is prime}
  if (Result <= (MaxPrime * MaxPrime)) then begin
    while Forever do begin
      RootN := round(Sqrt(Result));
      DivisorIndex := 1; {ignore the prime number 2}
      IsPrime := true;
      while (DivisorIndex < PrimeCount) and (RootN > Primes[DivisorIndex]) do begin
        if ((Result div Primes[DivisorIndex]) * Primes[DivisorIndex] = Result) then begin
          IsPrime := false;
          Break;
        end;
        inc(DivisorIndex);
      end;
      if IsPrime then
        Exit;
      inc(Result, 2);
    end;
  end;
end;
{====================================================================}


{===Hash functions===================================================}
function HashPJW(const S : string) : longint;
{Note: this hash function is described in "Practical Algorithms For
       Programmers" by Andrew Binstock and John Rex, Addison Wesley}
const
  BitsInLongint = sizeof(longint) * 8;
  ThreeQuarters = (BitsInLongint * 3) div 4;
  OneEighth = BitsInLongint div 8;
  HighBits : longint =
             (not longint(0)) shl (BitsInLongint - OneEighth);
var
  i    : longint;
  Test : longint;
begin
  Result := 0;
  for i := 1 to length(S) do begin
    Result := (Result shl OneEighth) + ord(S[i]);
    Test := Result and HighBits;
    if (Test <> 0) then
      Result := (Result xor (Test shr ThreeQuarters)) and
                not HighBits;
  end;
end;
{--------}
function HashELF(const S : string) : longint;
{Note: this hash function is described in "Practical Algorithms For
       Programmers" by Andrew Binstock and John Rex, Addison Wesley,
       with modifications in Dr Dobbs Journal, April 1996}
var
  G : longint;
  i : integer;
begin
  Result := 0;
  for i := 1 to length(S) do begin
    Result := (Result shl 4) + ord(S[i]);
    G := Result and $F0000000;
    if (G <> 0) then
      Result := Result xor (G shr 24);
    Result := Result and (not G);
  end;
end;
{--------}
function HashBKDR(const S : string) : longint;
{Note: this hash function is described in "The C Programming Language"
       by Brian Kernighan and Donald Ritchie, Prentice Hall}
var
  i : integer;
begin
  Result := 0;
  for i := 1 to length(S) do begin
    Result := (Result * 31) + ord(S[i]);
  end;
end;
{====================================================================}


{===THashTable=======================================================}
constructor THashTable.Create(DataOwner  : boolean);
begin
  acNodeSize := 0;
  inherited Create(DataOwner);
  {create the table, default size is StartTableSize}
  GetMem(htlArray, StartTableSize * sizeof(THashElement));
  FillChar(htlArray^, StartTableSize * sizeof(THashElement), 0);
  htlTableSize := StartTableSize;
  {the default hash function is Kernighan and Ritchie's}
  htlHashFunc := HashBKDR;
end;
{--------}
constructor THashTable.Clone(Source : TAbstractContainer;
                  DataOwner : boolean; NewCompare : TCompareFunc);
var
  OldHashTable : THashTable absolute Source;
  InUseCount   : integer;
  Inx          : integer;
  NewData      : pointer;
begin
  if not (Source is THashTable) then
    RaiseError(escBadSource);

  Create(DataOwner);
  HashFunction := OldHashTable.HashFunction;
  IgnoreCase := OldHashTable.IgnoreCase;
  if Assigned(NewCompare) then
    Compare := NewCompare
  else
    Compare := OldHashTable.Compare;
  DupData := OldHashTable.DupData;
  DisposeData := OldHashTable.DisposeData;

  InUseCount := OldHashTable.Count;
  for Inx := 0 to pred(OldHashTable.TableSize) do begin
    with PHashElementArray(OldHashTable.htlArray)^[Inx] do begin
      if (heState = hesInUse) then begin
        if IsDataOwner then
          NewData := DupData(heData)
        else
          NewData := heData;
        try
          {$IFDEF Windows}
          Insert(heString^, NewData);
          {$ELSE}
          Insert(heString, NewData);
          {$ENDIF}
        except
          if IsDataOwner and Assigned(NewData) then
            DisposeData(NewData);
          raise;
        end;{try..except}
        dec(InUseCount);
        if (InUseCount = 0) then
          Break;
      end;
    end;
  end;
end;
{--------}
destructor THashTable.Destroy;
begin
  inherited Destroy;
  FreeMem(htlArray, htlTableSize * sizeof(THashElement));
end;
{--------}
procedure THashTable.Delete(const aKey : string);
begin
  htlDeletePrim(aKey, false);
end;
{--------}
procedure THashTable.Empty;
var
  Inx : integer;
begin
  for Inx := 0 to pred(htlTableSize) do begin
    with PHashElementArray(htlArray)^[Inx] do begin
      if (heState = hesInUse) then begin
        if IsDataOwner then
          DisposeData(heData);
        {$IFDEF Windows}
        DisposeStr(heString);
        {$ELSE}
        heString := '';
        {$ENDIF}
      end;
      heState := hesEmpty;
    end;
  end;
  acCount := 0;
end;
{--------}
procedure THashTable.Erase(const aKey : string);
begin
  htlDeletePrim(aKey, true);