unit RehashC;
//*******************************************************
// Hash table with open addressing and linear probing,
// deletion, and rehashing class.
//*******************************************************
// Copyright (C) 1998 John Wiley & Sons, Inc.
// All rights reserved. See additional copyright
// information in Readme.txt.
//*******************************************************

interface

uses
    SysUtils;

const
    UNUSED = -2147483647;
    DELETED = -2147483646;

type
    TRehashReturnValue =
        (reInserted, reFound, reNotFound, reTableFull, reDeleted);
    TOperation = (opInsert, opLocate, opDelete);

    // The table's data type.
    TTableData = Longint;
    TDataArray = array [0..1000000] of TTableData;
    PDataArray = ^TDataArray;

    TBoolArray = array [0..1000000] of Boolean;
    PBoolArray = ^TBoolArray;

    TRehashTable = class(TObject)
        private
            TableSize : Integer;    // Total number allocated.
            NumUnused : Integer;    // Number still unused.
            HashTable : PDataArray; // The hash table array.
            function FindOrInsert(value : TTableData; var probes : Integer; op : TOperation) : TRehashReturnValue;

        public
            destructor Destroy; override;
            procedure CreateTable(table_size : Integer);
            function InsertItem(value : TTableData; var probes : Integer) : TRehashReturnValue;
            function LocateItem(value : TTableData; var probes : Integer) : TRehashReturnValue;
            function DeleteItem(value : TTableData; var probes : Integer) : TRehashReturnValue;
            procedure Rehash;
            function NumItems : Integer;
            function TableValue(pos : Integer) : TTableData;
    end;

implementation

// Free dynamically allocated memory.
destructor TRehashTable.Destroy;
begin
    if (TableSize > 0) then FreeMem(HashTable);
    inherited Destroy;
end;

// Create a new hash table.
procedure TRehashTable.CreateTable(table_size : Integer);
var
    i : Integer;
begin
    // Free old memory.
    if (TableSize > 0) then FreeMem(HashTable);

    TableSize := table_size;
    GetMem(HashTable, TableSize * SizeOf(TTableData));

    // Set all entries to UNUSED.
    for i := 0 to TableSize - 1 do HashTable^[i] := UNUSED;
    NumUnused := TableSize;
end;

// Insert an item in a hash table. Return reFound if the
// item is already in the table, reInserted if we insert
// the value, and reTableFull if there is no room.
function TRehashTable.InsertItem(value : TTableData; var probes : Integer) : TRehashReturnValue;
begin
    Result := FindOrInsert(value, probes, opInsert);
end;

// Locate an item in a hash table.
function TRehashTable.LocateItem(value : TTableData; var probes : Integer) : TRehashReturnValue;
begin
    Result := FindOrInsert(value, probes, opLocate);
end;

// Delete an item from the hash table.
function TRehashTable.DeleteItem(value : TTableData; var probes : Integer) : TRehashReturnValue;
begin
    Result := FindOrInsert(value, probes, opDelete);
end;

// Find the item if it is present. Otherwise insert it if
// insert is true.
function TRehashTable.FindOrInsert(value : TTableData; var probes : Integer; op : TOperation) : TRehashReturnValue;
var
    new_value : TTableData;
    pos       : Integer;
begin
    probes := 1;
    pos := (value mod TableSize);
    repeat // Repeat infinitely.
        new_value := HashTable^[pos];

        // If we found the value, we're done.
        if (new_value = value) then
        begin
            if (op = opDelete) then
            begin
                HashTable^[pos] := DELETED;
                Result := reDeleted;
            end else
                Result := reFound;
            exit;
        end;

        // If the entry is unused or deleted, we can
        // insert it here.
        if ((op = opInsert) and
            ((new_value = UNUSED) or (new_value = DELETED))) then
        begin
            HashTable^[pos] := value;
            Result := reInserted;
            NumUnused := NumUnused - 1;
            exit;
        end;

        // If the entry is unused, it is not in the table.
        if (((op = opLocate) or (op = opDelete)) and
             (new_value = UNUSED)) then
        begin
            Result := reNotFound;
            exit;
        end;

        // Try the next location in the probe sequence.
        pos := (pos + 1) mod TableSize;
        probes := probes + 1;

        // See if we have checked every entry.
        if (probes > TableSize) then
        begin
            if (op = opInsert) then
                Result := reTableFull
            else
                Result := reNotFound;
            exit;
        end;
    until (False); // End infinite loop looking for the value.
end;

// Rehash the hash table to reclaim deleted entries.
procedure TRehashTable.Rehash;
var
    not_rehashed     : PBoolArray;
    i, pos           : Integer;
    value, new_value : TTableData;
begin
    // Allocate space for the rehashed flags.
    GetMem(not_rehashed, TableSize * SizeOf(Boolean));

    // Mark all items as not rehashed.
    for i := 0 to TableSize - 1 do not_rehashed^[i] := True;

    // Look for unrehashed items.
    for i := 0 to TableSize - 1 do
    begin
        if (not_rehashed^[i]) then
        begin
            value := HashTable^[i];
            HashTable^[i] := UNUSED;

            // Don't rehash deleted or unused entries.
            if ((value = DELETED) or (value = UNUSED)) then
                continue;

            // Otherwise follow this value's probe sequence
            // until we find an empty, deleted, or an
            // unrehashed item.
            pos := value mod TableSize;
            repeat // Repeat infinitely.
                new_value := HashTable^[pos];

                // If this spot is empty or deleted, place
                // the item here.
                if ((new_value = UNUSED) or (new_value = DELETED)) then
                begin
                    HashTable^[pos] := value;
                    not_rehashed^[pos] := False;
                    break;
                end;

                // If this spot holds a non-rehashed item,
                // swap them and continue.
                if (not_rehashed^[pos]) then
                begin
                    HashTable^[pos] := value;
                    not_rehashed^[pos] := False;
                    value := new_value;
                    pos := value mod TableSize;
                end else
                    pos := (pos + 1) mod TableSize;
            until (False); // End infinite loop.
        end; // End if (not_rehashed^[i]) then ...
    end; // End for i := 0 to TableSize - 1 do ...
end;

// Return the number of items in the hash table.
function TRehashTable.NumItems : Integer;
begin
    Result := TableSize;
end;

// Return the value in the indicated position.
function TRehashTable.TableValue(pos : Integer) : TTableData;
begin
    Result := HashTable^[pos];
end;

end.
