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

interface

uses
    SysUtils, forms;

const
    UNUSED = -2147483647;
    BUCKET_SIZE = 5;
type
    TBucketReturnValue =
        (bktInserted, bktFound, bktNotFound);

    // The table's data type.
    TTableData = Longint;
    TBucket = array [0..BUCKET_SIZE - 1] of TTableData;

    TBucketHashTable = class(TObject)
        private
            NumBuckets  : Integer; // # of normal buckets.
            MaxOverflow : Integer; // Index of last overflow bucket.
            TheBucket   : TBucket; // A single bucket.
            DataFile    : file of TBucket;

            destructor Destroy; override;
            procedure GetBucket(num : Longint);
            procedure PutBucket(num : Longint);
            procedure NewOverflow(var bucket_probes, item_probes : Integer);
        public
            procedure CreateTable(num_buckets : 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

// Close the file if it is open.
destructor TBucketHashTable.Destroy;
begin
    if (NumBuckets > 0) then CloseFile(DataFile);
    inherited Destroy;
end;

// Create a new hash table.
procedure TBucketHashTable.CreateTable(num_buckets : Integer);
var
    i     : Integer;
    fname : String;
begin
    NumBuckets := num_buckets;
    MaxOverflow := NumBuckets - 1;

    // Get the executable directory's name.
    fname := Application.ExeName;
    while (fname[Length(fname)] <> '\') do
        fname := Copy(fname, 0, Length(fname) - 1);
    fname := fname + 'Bucket2.dat';

    // Create the file.
    AssignFile(DataFile, fname);
    Rewrite(DataFile);

    // Blank TheBucket.
    for i := 0 to BUCKET_SIZE - 1 do
        TheBucket[i] := UNUSED;

    // Write the empty buckets into the file.
    for i := 0 to NumBuckets - 1 do
        Write(DataFile, TheBucket);
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;

    // Get the bucket where the item should be.
    bucket := (value mod NumBuckets);
    bucket_probes := bucket_probes + 1;
    GetBucket(bucket);

    // See if the last position in the bucket is used.
    item_probes := item_probes + 1;
    bucket_full :=
        (TheBucket[BUCKET_SIZE - 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;
            GetBucket(bucket);
            bucket_full :=
                (TheBucket[BUCKET_SIZE - 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 BUCKET_SIZE - 1 do
    begin
        item_probes := item_probes + 1;
        if (TheBucket[pos] = UNUSED) then break;
    end;

    // Insert the item.
    TheBucket[pos] := value;

    // Update the data file.
    bucket_probes := bucket_probes + 1;
    PutBucket(bucket);

    Result := bktInserted;
end;

// Get a bucket.
procedure TBucketHashTable.GetBucket(num : Longint);
begin
    Seek(DataFile, num);
    Read(DataFile, TheBucket);
end;

// Save a bucket to file.
procedure TBucketHashTable.PutBucket(num : Longint);
begin
    Seek(DataFile, num);
    Write(DataFile, TheBucket);
end;

// Create a new overflow bucket.
procedure TBucketHashTable.NewOverflow(var bucket_probes, item_probes : Integer);
var
    i : Integer;
begin
    // Blank TheBucket.
    for i := 0 to BUCKET_SIZE - 1 do
        TheBucket[i] := UNUSED;
    item_probes := item_probes + BUCKET_SIZE;

    // Write the new bucket to disk.
    MaxOverflow := MaxOverflow + 1;
    bucket_probes := bucket_probes + 1;
    PutBucket(MaxOverflow);
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 := 0;
    item_probes := 0;

    // Get the bucket it belongs in.
    bucket := (value mod NumBuckets);
    bucket_probes := bucket_probes + 1;
    GetBucket(bucket);

    // Look for the item or an unused position.
    for pos := 0 to BUCKET_SIZE - 1 do
    begin
        item_probes := item_probes + 1;
        if (TheBucket[pos] = UNUSED) then
        begin
            Result := bktNotFound; // It's not here.
            exit;
        end;
        if (TheBucket[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;
        GetBucket(bucket);

        for pos := 0 to BUCKET_SIZE - 1 do
        begin
            item_probes := item_probes + 1;
            if (TheBucket[pos] = UNUSED) then
            begin
                Result := bktNotFound; // It's not here.
                exit;
            end;
            if (TheBucket[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
        GetBucket(i);
        if (i = NumBuckets) then
            Result := Result + CR + '*** OVERFLOW ***' +
            CR + CR;
        Result := Result + Format('%2d:', [i]);
        for j := 0 to BUCKET_SIZE - 1 do
        begin
            if (TheBucket[j] = UNUSED) then
                Result := Result + ' ---  '
            else if (TheBucket[j] = highlight_value) then
                Result := Result + Format('*%3d* ', [TheBucket[j]])
            else
                Result := Result + Format(' %3d  ', [TheBucket[j]]);
        end;
        Result := Result + CR;
    end;
end;

end.
