unit ChainC;
//*******************************************************
// Hash table with chaining class.
//*******************************************************
// Copyright (C) 1998 John Wiley & Sons, Inc.
// All rights reserved. See additional copyright
// information in Readme.txt.
//*******************************************************

interface

uses
    SysUtils;
    
type
    TChainReturnValue = (chInserted, chFound, chNotFound);
    TTableData = Longint;
    PChainCell = ^TChainCell;
    TChainCell = record
        Value    : TTableData;
        NextCell : PChainCell;
    end;
    TChainCellArray = array [0..1000000] of TChainCell;
    PChainCellArray = ^TChainCellArray;

    TChainingHashTable = class(TObject)
        private
            ListTops  : PChainCellArray;
            NumChains : Integer;
            SortLists : Boolean;

            procedure FreeChains;
            function InsertItemSorted(value : TTableData; var probes : Integer) : TChainReturnValue;
            function InsertItemUnsorted(value : TTableData; var probes : Integer) : TChainReturnValue;
            function LocateItemSorted(value : TTableData; var probes : Integer) : TChainReturnValue;
            function LocateItemUnsorted(value : TTableData; var probes : Integer) : TChainReturnValue;
            function RemoveItemSorted(value : TTableData; var probes : Integer) : TChainReturnValue;
            function RemoveItemUnsorted(value : TTableData; var probes : Integer) : TChainReturnValue;
        public
            destructor Destroy; override;
            function InsertItem(value : TTableData; var probes : Integer) : TChainReturnValue;
            function LocateItem(value : TTableData; var probes : Integer) : TChainReturnValue;
            function RemoveItem(value : TTableData; var probes : Integer) : TChainReturnValue;
            function TextRepresentation(highlight_value : TTableData) : String;
            procedure CreateTable(num_chains : Integer; sorted : Boolean);
    end;

implementation

// Free dynamically allocated memory.
destructor TChainingHashTable.Destroy;
begin
    FreeChains;
    inherited Destroy;
end;

// Free dynamically allocated memory.
procedure TChainingHashTable.FreeChains;
var
    i         : Integer;
    cell, nxt : PChainCell;
begin
    if (NumChains < 1) then exit;
    for i := 0 to NumChains - 1 do
    begin
        cell := ListTops^[i].NextCell;
        while (cell <> nil) do
        begin
             nxt := cell^.NextCell;
             Dispose(cell);
             cell := nxt;
        end;
    end;
    FreeMem(ListTops);
end;

// Insert an item into a sorted hash table.
function TChainingHashTable.InsertItemSorted(value : TTableData; var probes : Integer) : TChainReturnValue;
var
    cell, nxt, new_cell : PChainCell;
begin
    // See which chain should hold the value.
    cell := @ListTops^[value mod NumChains];

    // See where the item belongs in its chain.
    probes := 1;
    nxt := cell.NextCell;
    while (nxt <> nil) do
    begin
        if (nxt^.Value >= value) then break;
        cell := nxt;
        nxt := cell^.NextCell;
        probes := probes + 1;
    end;

    // See if the item is already in the table.
    if (nxt <> nil) then
        if (nxt^.Value = value) then
        begin
            Result := chFound;
            exit;
        end;

    // Insert the item after cell.
    New(new_cell);
    new_cell^.Value := value;
    cell^.NextCell := new_cell;
    new_cell^.NextCell := nxt;

    Result := chInserted;
end;

// Insert an item into a unsorted hash table.
function TChainingHashTable.InsertItemUnsorted(value : TTableData; var probes : Integer) : TChainReturnValue;
var
    cell, new_cell : PChainCell;
begin
    // See if the item is already in the table.
    if (LocateItemUnsorted(value, probes) = chFound) then
    begin
        Result := chFound;
        exit;
    end;

    // See which chain should hold the value.
    cell := @ListTops^[value mod NumChains];

    // Insert the item at the top of the chain.
    New(new_cell);
    new_cell^.Value := value;
    new_cell^.NextCell := cell^.NextCell;
    cell^.NextCell := new_cell;

    Result := chInserted;
end;

// Locate an item in a sorted hash table.
function TChainingHashTable.LocateItemSorted(value : TTableData; var probes : Integer) : TChainReturnValue;
var
    cell : PChainCell;
begin
    // See which chain should hold the value.
    cell := ListTops^[value mod NumChains].NextCell;
    while (cell <> nil) do
    begin
        probes := probes + 1;
        if (cell^.Value >= value) then break;
        cell := cell^.NextCell;
    end;

    Result := chNotFound;
    if (cell <> nil) then
        if (cell.Value = value) then
            Result := chFound;
end;

// Locate an item in an unsorted hash table.
function TChainingHashTable.LocateItemUnsorted(value : TTableData; var probes : Integer) : TChainReturnValue;
var
    cell : PChainCell;
begin
    // See which chain should hold the value.
    cell := ListTops^[value mod NumChains].NextCell;
    while (cell <> nil) do
    begin
        probes := probes + 1;
        if (cell^.Value = value) then break;
        cell := cell^.NextCell;
    end;

    if (cell <> nil) then
        Result := chFound
    else
        Result := chNotFound;
end;

// Remove an item in a sorted hash table.
function TChainingHashTable.RemoveItemSorted(value : TTableData; var probes : Integer) : TChainReturnValue;
var
    cell, nxt_cell : PChainCell;
begin
    // See which chain should hold the value.
    cell := @ListTops^[value mod NumChains];
    nxt_cell := cell^.NextCell;
    while (nxt_cell <> nil) do
    begin
        probes := probes + 1;
        if (nxt_cell^.Value >= value) then break;
        cell := nxt_cell;
        nxt_cell := cell^.NextCell;
    end;

    Result := chNotFound;
    if (nxt_cell <> nil) then
        if (nxt_cell.Value = value) then
        begin
            // We found it. Remove the cell.
            cell^.NextCell := nxt_cell^.NextCell;
            Dispose(nxt_cell);
            Result := chFound;
        end;
end;

// Locate an item in an unsorted hash table.
function TChainingHashTable.RemoveItemUnsorted(value : TTableData; var probes : Integer) : TChainReturnValue;
var
    cell, nxt_cell : PChainCell;
begin
    // See which chain should hold the value.
    cell := @ListTops^[value mod NumChains];
    nxt_cell := cell^.NextCell;
    while (nxt_cell <> nil) do
    begin
        probes := probes + 1;
        if (nxt_cell^.Value = value) then break;
        cell := nxt_cell;
        nxt_cell := cell^.NextCell;
    end;

    Result := chNotFound;
    if (nxt_cell <> nil) then
    begin
        // We found it. Remove the cell.
        cell^.NextCell := nxt_cell^.NextCell;
        Dispose(nxt_cell);
        Result := chFound;
    end;
end;

// Insert an item in a hash table. Return chFound if the
// item is already in the table, chInserted otherwise.
function TChainingHashTable.InsertItem(value : TTableData; var probes : Integer) : TChainReturnValue;
begin
    probes := 0;
    if SortLists then
        Result := InsertItemSorted(Value, probes)
    else
        Result := InsertItemUnsorted(Value, probes);
end;

// Locate an item in a hash table.
function TChainingHashTable.LocateItem(value : TTableData; var probes : Integer) : TChainReturnValue;
begin
    probes := 0;
    if SortLists then
        Result := LocateItemSorted(Value, probes)
    else
        Result := LocateItemUnsorted(Value, probes);
end;

// Remove an item from a hash table.
function TChainingHashTable.RemoveItem(value : TTableData; var probes : Integer) : TChainReturnValue;
begin
    probes := 0;
    if SortLists then
        Result := RemoveItemSorted(Value, probes)
    else
        Result := RemoveItemUnsorted(Value, probes);
end;

// Return a textual representation of the hash table.
function TChainingHashTable.TextRepresentation(highlight_value : TTableData) : String;
const
    CR = #13#10;
var
    i    : Integer;
    cell : PChainCell;
begin
    Result := '';
    for i := 0 to NumChains - 1 do
    begin
        Result := Result + Format('%3d:', [i]);
        cell := ListTops^[i].NextCell;
        while (cell <> nil) do
        begin
            if (cell^.Value = highlight_value) then
                Result := Result +
                    Format('*%3d* ', [cell^.Value])
            else
                Result := Result +
                    Format(' %3d  ', [cell^.Value]);
            cell := cell^.NextCell;
        end;
        Result := Result + CR;
      end;
end;

// Create the hash table.
procedure TChainingHashTable.CreateTable(num_chains : Integer; sorted : Boolean);
var
    i : Integer;
begin
    FreeChains;
    NumChains := num_chains;
    GetMem(ListTops, NumChains * SizeOf(TChainCell));

    // Initialize the chains.
    for i := 0 to NumChains - 1 do
        ListTops^[i].NextCell := nil;

    SortLists := sorted;
end;

end.
