dws2integerhashtable.pas

script language

{**********************************************************************}
{                                                                      }
{    "The contents of this file are subject to the Mozilla Public      }
{    License Version 1.1 (the "License"); you may not use this         }
{    file except in compliance with the License. You may obtain        }
{    a copy of the License at                                          }
{                                                                      }
{    http://www.mozilla.org/MPL/                                       }
{                                                                      }
{    Software distributed under the License is distributed on an       }
{    "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express       }
{    or implied. See the License for the specific language             }
{    governing rights and limitations under the License.               }
{                                                                      }
{    The Original Code is DelphiWebScriptII source code, released      }
{    January 1, 2001                                                   }
{                                                                      }
{    The Initial Developer of the Original Code is Matthias            }
{    Ackermann. Portions created by Matthias Ackermann are             }
{    Copyright (C) 2000 Matthias Ackermann, Switzerland. All           }
{    Rights Reserved.                                                  }
{                                                                      }
{    Contributor(s): ______________________________________.           }
{                                                                      }
{**********************************************************************}

{$I dws2.inc}

unit dws2IntegerHashtable;

interface

type
  PHashItem = ^THashItem;
  THashItem = record
    Key: Integer;
    Value: TObject;
    Twin: PHashItem;
  end;

  PHashItems = ^THashItems;
  THashItems = array[0..MaxInt div Sizeof(Integer) - 1] of PHashItem;

  TIntegerHashTable = class;

  THashEnumeration = class
  private
    FHashTable: TIntegerHashTable;
    FItem: PHashItem;
    FIndex: Integer;
    function GetKey: Integer;
    function GetValue: TObject;
  protected
    constructor Create(HashTable: TIntegerHashTable);
    procedure NotifyDelete(RemovedItem, PreviousItem: PHashItem);
  published
    destructor Destroy; override;
    function Next: Boolean;
    property Key: Integer read GetKey;
    property Value: TObject read GetValue;
  end;

  TIntegerHashTable = class
  private
    FCapacity: Integer;
    FSize: Integer;
    FThreshold: Integer;
    FLoadFactor: Integer; // In percent
    FEnumeration: THashEnumeration;
    FItems: PHashItems;
    procedure Rehash(NewCapacity: Integer);
  public
    constructor Create(InitCapacity: Integer = 256; LoadFactor: Integer = 75);
    destructor Destroy; override;
    function GetEnumeration: THashEnumeration;
    property Capacity: Integer read FCapacity;
    property Size: Integer read FSize;
  public
    // Returns the value for key
    function Get(Key: Integer): TObject;
    // Adds the pair key/value to the hashtable
    procedure Put(Key: Integer; Value: TObject);
    // Checks if the key is part of the hashtable
    function HasKey(Key: Integer): Boolean;
    // Removes a pair key/value from the hashtable
    function RemoveKey(Key: Integer): TObject;
  end;

implementation

uses
  SysUtils;

{ THashEnumeration }

constructor THashEnumeration.Create;
begin
  FHashTable := HashTable;
end;

destructor THashEnumeration.Destroy;
begin
  inherited;
  FHashTable.FEnumeration := nil;
end;

function THashEnumeration.GetKey: Integer;
begin
  Result := FItem.Key;
end;

function THashEnumeration.GetValue: TObject;
begin
  Result := FItem.Value;
end;

function THashEnumeration.Next;
begin
  if FItem <> nil then
      FItem := FItem.Twin;

  while (FItem = nil) and (FIndex < FHashTable.Capacity) do
  begin
    FItem := FHashTable.FItems[FIndex];
    Inc(FIndex);
  end;

  Result := Assigned(FItem);
end;

procedure THashEnumeration.NotifyDelete(RemovedItem, PreviousItem: PHashItem);
begin
  if (RemovedItem = FItem) then
    FItem := PreviousItem;
end;

{ THashTable }

constructor TIntegerHashTable.Create;
begin
  if (InitCapacity < 1) or (InitCapacity >= MaxInt div Sizeof(Integer)) then
    raise Exception.CreateFmt('Invalid InitCapacity: %d', [InitCapacity]);
  if (LoadFactor < 0) or (LoadFactor > 100) then
    raise Exception.CreateFmt('Invalid LoadFactor: %d', [LoadFactor]);
  FLoadFactor := LoadFactor;
  Rehash(InitCapacity);
end;

destructor TIntegerHashTable.Destroy;
var
  x: Integer;
begin
  for x := 0 to FCapacity - 1 do
    if Assigned(FItems[x]) then
      Dispose(FItems[x]);
  FreeMem(FItems);
  inherited;
end;

function TIntegerHashTable.GetEnumeration: THashEnumeration;
begin
  result := THashEnumeration.Create(Self);
  FEnumeration := result;
end;

procedure TIntegerHashTable.Rehash(NewCapacity: Integer);
var
  x, hash: Integer;
  newItems: PHashItems;
  itm, Twin: PHashItem;
begin
  // Enlarge the size of the hashtable
  GetMem(newItems, Sizeof(PHashItem) * NewCapacity);

  // Clear new space
  for x := 0 to NewCapacity - 1 do
    newItems[x] := nil;

  // Transfer items to the new hashtable
  for x := 0 to FCapacity - 1 do
  begin
    itm := FItems[x];
    while itm <> nil do
    begin
      Twin := itm.Twin;
      hash := itm.Key mod NewCapacity;
      itm.Twin := newItems[hash];
      newItems[hash] := itm;
      itm := Twin;
    end;
  end;

  FreeMem(FItems);

  FItems := newItems;
  FThreshold := (NewCapacity div 100) * FLoadFactor;

  FCapacity := NewCapacity;
end;

function TIntegerHashTable.Get(Key: Integer): TObject;
var
  hashItem: PHashItem;
begin
  hashItem := FItems[Key mod FCapacity];

  while hashItem <> nil do
  begin
    if hashItem.Key = Key then
    begin
      result := hashItem.Value;
      exit;
    end;
    hashItem := hashItem.Twin;
  end;

  result := nil;
end;

function TIntegerHashTable.HasKey(Key: Integer): Boolean;
var
  hashItem: PHashItem;
begin
  result := false;

  hashItem := FItems[Key mod FCapacity];

  while hashItem <> nil do
  begin
    if hashItem.Key = Key then
    begin
      result := True;
      exit;
    end;
    hashItem := hashItem.Twin;
  end;
end;

procedure TIntegerHashTable.Put(Key: Integer; Value: TObject);
var
  newItem: PHashItem;
  hash: Integer;
begin
  Inc(FSize);

  if FSize > FThreshold then
    // Double the size of the hashtable
    Rehash(FCapacity * 2);

  // Create a new item
  New(newItem);
  newItem.Key := Key;
  newItem.Value := Value;
  newItem.Twin := nil;

  // Find item with same hash-key
  hash := Key mod FCapacity;

  // Insert new item to the existing (if any)
  newItem.Twin := FItems[hash];
  FItems[hash] := newItem;
end;

function TIntegerHashTable.RemoveKey(Key: Integer): TObject;
var
  hashItem, lastItem: PHashItem;
  hash: Integer;
begin
  hash := Key mod FCapacity;
  hashItem := FItems[hash];
  lastItem := nil;

  while hashItem <> nil do
  begin
    if hashItem.Key = Key then
    begin
      // Notify Enumeration (if any)
      if Assigned(FEnumeration) then
        FEnumeration.NotifyDelete(hashItem, lastItem);

      // Remove item from pointer chain
      if lastItem = nil then
        FItems[hash] := hashItem.Twin
      else
        lastItem.Twin := hashItem.Twin;

      // Dispose item
      Result := hashItem.Value;
      Dispose(hashItem);
      Dec(FSize);
      Exit;
    end;
    lastItem := hashItem;
    hashItem := hashItem.Twin;
  end;
  Result := nil;
end;

end.