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

interface

uses
    SysUtils;

const
    UNUSED = -2147483647;

type
    TBucketReturnValue =
        (bktInserted, bktFound, bktNotFound);

    // The table's data type.
    TTableData = Longint;
    TBucket = array [0..1000000] of TTableData;
    PBucket = ^TBucket;
    TBucketArray = array [0..1000000] of PBucket;
    PBucketArray = ^TBucketArray;

    TBucketHashTable = class(TObject)
        private
            NumBuckets  : Integer; // # of normal buckets.
            MaxOverflow : Integer; // Index of last overflow bucket.
            BucketSize  : Integer; // Items per bucket.
            Buckets     : PBucketArray;

            procedure FreeBuckets;
            procedure NewOverflow(var bucket_probes, item_probes : Integer);
        public
            destructor Destroy; override;
            procedure CreateTable(num_buckets, bucket_size : Integer);
            function InsertItem(value : TTableData; var bucket_probes, item_probes : Integer) : TBucketReturnValue;
            function LocateItem(value : TTableData; var bucket_probes, item_probes : Integer) : TBucketReturnValue;
            function TextRepresentation(highlight_value : TTableData) : String;
    end;

implementation

// Free dynamically allocated memory.
destructor TBucketHashTable.Destroy;
begin
    FreeBuckets;
    inherited Destroy;
end;

// Free dynamically allocated memory.
procedure TBucketHashTable.FreeBuckets;
var
    i : Integer;
begin
    if (NumBuckets < 1) then exit;
    for i := 0 to MaxOverflow do
        FreeMem(Buckets^[i]);
    FreeMem(Buckets);
end;

// Create a new hash table.
procedure TBucketHashTable.CreateTable(num_buckets, bucket_size : Integer);
var
    i, j : Integer;
begin
    FreeBuckets;
    NumBuckets := num_buckets;
    BucketSize := bucket_size;
    MaxOverflow := NumBuckets - 1;
    GetMem(Buckets, NumBuckets * SizeOf(PBucket));

    // Create the buckets.
    for i := 0 to NumBuckets - 1 do
    begin
        GetMem(Buckets^[i], BucketSize * SizeOf(TTableData));
        for j := 0 to BucketSize - 1 do
            Buckets^[i]^[j] := UNUSED;
    end;
end;

// Insert an item in a hash table. Return bktFound if the
// item is already in the table, bktInserted otherwise.
function TBucketHashTable.InsertItem(value : TTableData; var bucket_probes, item_probes : Integer) : TBucketReturnValue;
var
    bucket, pos : Integer;
    bucket_full : Boolean;
begin
    bucket_probes := 0;
    item_probes := 0;

    // See if the item is already present.
    if (LocateItem(value, bucket_probes, item_probes) =
        bktFound) then
    begin
        Result := bktFound;
        exit;
    end;

    // See what bucket it belongs in.
    bucket := (value mod NumBuckets);

    // See if the last position in the bucket is used.
    item_probes := item_probes + 1;
    bucket_probes := bucket_probes + 1;
    bucket_full :=
        (Buckets^[bucket]^[BucketSize - 1] <> UNUSED);

    // If the bucket is full, use the last overflow bucket.
    if (bucket_full) then
    begin
        bucket := MaxOverflow;
        if (bucket < NumBuckets) then
        begin
            bucket_full := True
        end else begin
            bucket_probes := bucket_probes + 1;
            bucket_full :=
                (Buckets^[bucket]^[BucketSize - 1] <> UNUSED);
        end;
    end;

    // If the overflow buckets are full, make a new one.
    if (bucket_full) Then
    begin
        NewOverflow(bucket_probes, item_probes);
        bucket := MaxOverflow;
    end;

    // At this point bucket gives the index of a bucket
    // with at least one unused entry. Find the first
    // unused entry and use it.
    for pos := 0 to BucketSize - 1 do
    begin
        item_probes := item_probes + 1;
        if (Buckets^[bucket]^[pos] = UNUSED) then break;
    end;

    // Insert the item.
    Buckets^[bucket]^[pos] := value;
    Result := bktInserted;
end;

// Create a new overflow bucket.
procedure TBucketHashTable.NewOverflow(var bucket_probes, item_probes : Integer);
var
    new_buckets : PBucketArray;
    i           : Integer;
begin
    // Allocate the new bucket pointers.
    MaxOverflow := MaxOverflow + 1;
    GetMem(new_buckets, (MaxOverflow + 1) * SizeOf(PBucket));

    // Copy the old buckets into the new structure.
    for i := 0 to MaxOverflow - 1 do
        new_buckets^[i] := Buckets^[i];

    // Make Buckets point to the new bucket pointer memory.
    FreeMem(Buckets);
    Buckets := new_buckets;

    // Create the new bucket.
    GetMem(Buckets^[MaxOverflow], BucketSize * SizeOf(TTableData));
    for i := 0 to BucketSize - 1 do
        Buckets^[MaxOverflow]^[i] := UNUSED;
end;

// Locate an item in a hash table.
function TBucketHashTable.LocateItem(value : TTableData; var bucket_probes, item_probes : Integer) : TBucketReturnValue;
var
    bucket, pos : Integer;
begin
    bucket_probes := 1;
    item_probes := 0;

    // See what bucket it belongs in.
    bucket := (value mod NumBuckets);

    // Look for the item or an unused position.
    for pos := 0 to BucketSize - 1 do
    begin
        item_probes := item_probes + 1;
        if (Buckets^[bucket]^[pos] = UNUSED) then
        begin
            Result := bktNotFound; // It's not here.
            exit;
        end;
        if (Buckets^[bucket]^[pos] = value) then
        begin
            Result := bktFound;    // We found it.
            exit;
        end;
    end;

    // If we haven't found it, check the overflow buckets.
    for bucket := NumBuckets to MaxOverflow do
    begin
        bucket_probes := bucket_probes + 1;
        for pos := 0 to BucketSize - 1 do
        begin
            item_probes := item_probes + 1;
            if (Buckets^[bucket]^[pos] = UNUSED) then
            begin
                Result := bktNotFound; // It's not here.
                exit;
            end;
            if (Buckets^[bucket]^[pos] = value) then
            begin
                Result := bktFound;    // We found it.
                exit;
            end;
        end;
    end;

    // If we still haven't found it, it's not here.
    Result := bktNotFound;
end;

// Return a textual representation of the hash table.
function TBucketHashTable.TextRepresentation(highlight_value : TTableData) : String;
const
    CR = #13#10;
var
    i, j : Integer;
begin
    Result := '';
    for i := 0 to MaxOverflow do
    begin
        if (i = NumBuckets) then
            Result := Result + CR + '*** OVERFLOW ***' +
            CR + CR;
        Result := Result + Format('%2d:', [i]);
        for j := 0 to BucketSize - 1 do
        begin
            if (Buckets^[i]^[j] = UNUSED) then
                Result := Result + ' ---  '
            else if (Buckets^[i]^[j] = highlight_value) then
                Result := Result + Format('*%3d* ', [Buckets^[i]^[j]])
            else
                Result := Result + Format(' %3d  ', [Buckets^[i]^[j]]);
        end;
        Result := Result + CR;
    end;
end;

end.
