unit Bucket1F;
//*******************************************************
// Example program demonstrating a hash table with
// buckets.
//*******************************************************
// Copyright (C) 1998 John Wiley & Sons, Inc.
// All rights reserved. See additional copyright
// information in Readme.txt.
//*******************************************************

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, StdCtrls,
  Bucket1C;

type
  TBucketForm = class(TForm)
    Frame2: TGroupBox;
    Label1_0: TLabel;
    NewItemText: TEdit;
    CmdAdd: TButton;
    CmdFind: TButton;
    Frame3: TGroupBox;
    Label1_6: TLabel;
    Label1_2: TLabel;
    NumItemsText: TEdit;
    MaxValueText: TEdit;
    CmdCreateItems: TButton;
    Frame1: TGroupBox;
    Label1_3: TLabel;
    CmdCreateTable: TButton;
    NumBucketsText: TEdit;
    StatusLabel: TLabel;
    MainMenu1: TMainMenu;
    mnuFile: TMenuItem;
    mnuFileExit: TMenuItem;
    mnuHelp: TMenuItem;
    mnuHelpAbout: TMenuItem;
    TableScrollBox: TScrollBox;
    TableLabel: TLabel;
    BucketSizeText: TEdit;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure mnuFileExitClick(Sender: TObject);
    procedure mnuHelpAboutClick(Sender: TObject);
    procedure CmdCreateTableClick(Sender: TObject);
    procedure CmdCreateItemsClick(Sender: TObject);
    procedure CmdAddClick(Sender: TObject);
    procedure CmdFindClick(Sender: TObject);
    procedure DisplayStatus(msg : String; bprobes, iprobes : Integer);
    procedure ComputeAverageProbe(var bave_succ, bave_unsucc, iave_succ, iave_unsucc : Single);
    procedure NumBucketsTextChange(Sender: TObject);
    procedure NewItemTextChange(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
    MaxValue  : TTableData;
    HashTable : TBucketHashTable;
  public
    { Public declarations }
    destructor Destroy; override;
  end;

var
  BucketForm: TBucketForm;

implementation

{$R *.DFM}

// Create the hash table.
procedure TBucketForm.FormCreate(Sender: TObject);
begin
    Randomize;

    HashTable := TBucketHashTable.Create;
end;

// Free the hash table.
destructor TBucketForm.Destroy;
begin
    HashTable.Free;
    inherited Destroy;
end;

procedure TBucketForm.mnuFileExitClick(Sender: TObject);
begin
    Application.Terminate;
end;

procedure TBucketForm.mnuHelpAboutClick(Sender: TObject);
const
    break = #13#10#13#10;
begin
    MessageDlg(
        'This program demonstrates hashing with buckets. The main areas on the form are:' + break +
        'Table Creation: Enter the number of buckets you want and the bucket size. Then click the Create Table button to build a new hash table.' + break +
        'Random Items: Enter the number and maximum value of the random items you want to add and click the Create Items button.' + break +
        'Search: Enter a value and click the Add button to add the item to the table. Click the Find button to locate the item.'
        , mtInformation, [mbOK], 0);
end;

// Create a new hash table.
procedure TBucketForm.CmdCreateTableClick(Sender: TObject);
begin
    Screen.Cursor := crHourGlass;

    // This makes the HashTable create the lists.
    HashTable.CreateTable(
        StrToInt(NumBucketsText.Text),
        StrToInt(BucketSizeText.Text));

    MaxValue := 1;
    StatusLabel.Caption := 'Table created.';
    CmdCreateItems.Enabled := True;
    TableLabel.Caption := HashTable.TextRepresentation(-1);
    Screen.Cursor := crDefault;
end;

// Add random items to the hash table.
procedure TBucketForm.CmdCreateItemsClick(Sender: TObject);
var
    num, created, bucket_probes, item_probes : Integer;
    value, max_value                         : TTableData;
begin
    max_value := StrToInt(MaxValueText.Text);
    num := StrToInt(NumItemsText.Text);
    if (max_value < num) then
    begin
        ShowMessage('Max Value is too small.');
        exit;
    end;

    Screen.Cursor := crHourGlass;
    created := 0; // The number we have created.
    while (created < num) do
    begin
        value := Trunc(Random(max_value) + 1);
        if (value > MaxValue) then MaxValue := value;
        if (HashTable.InsertItem(value, bucket_probes,
            item_probes) = bktInserted) then
                created := created + 1;
    end;
    DisplayStatus('Done.', bucket_probes, item_probes);

    TableLabel.Caption := HashTable.TextRepresentation(-1);
    Screen.Cursor := crDefault;
end;

// Add an item to the hash table.
procedure TBucketForm.CmdAddClick(Sender: TObject);
var
    bucket_probes, item_probes : Integer;
    value                      : TTableData;
    status                     : TBucketReturnValue;
begin
    Screen.Cursor := crHourGlass;

    value := StrToInt(NewItemText.Text);
    if (value > MaxValue) then MaxValue := value;

    // Insert the item.
    status := HashTable.InsertItem(value, bucket_probes, item_probes);
    case status of
        bktFound:
            DisplayStatus('Found.', bucket_probes, item_probes);
        bktInserted:
            DisplayStatus('Inserted.', bucket_probes, item_probes);
    end;

    TableLabel.Caption := HashTable.TextRepresentation(value);
    Screen.Cursor := crDefault;
end;

// Find an item in the hash table.
procedure TBucketForm.CmdFindClick(Sender: TObject);
var
    value                      : TTableData;
    bucket_probes, item_probes : Integer;
    status                     : TBucketReturnValue;
begin
    Screen.Cursor := crHourGlass;

    value := StrToInt(NewItemText.Text);
    if (value > MaxValue) then MaxValue := value;

    status := HashTable.LocateItem(value, bucket_probes, item_probes);
    case status of
        bktNotFound:
            DisplayStatus('Not found.', bucket_probes, item_probes);
        bktFound:
            DisplayStatus('Found.', bucket_probes, item_probes);
    end;

    TableLabel.Caption := HashTable.TextRepresentation(value);
    Screen.Cursor := crDefault;
end;

// Display a status message.
procedure TBucketForm.DisplayStatus(msg : String; bprobes, iprobes : Integer);
const
    CR = #13#10;
var
    bave_succ, bave_unsucc : single;
    iave_succ, iave_unsucc : single;
begin
    ComputeAverageProbe(bave_succ, bave_unsucc, iave_succ, iave_unsucc);
    StatusLabel.Caption := msg + CR +
        Format('This probe: %d/%d.', [bprobes, iprobes]) + CR +
        Format('Ave successful probe: %.2f/%.2f.', [bave_succ, iave_succ]) + CR +
        Format('Ave unsuccessful probe: %.2f/%.2f.', [bave_unsucc, iave_unsucc]);
end;

// Compute the average lengths of probe sequences.
procedure TBucketForm.ComputeAverageProbe(var bave_succ, bave_unsucc, iave_succ, iave_unsucc : Single);
var
    status                           : TBucketReturnValue;
    trial, bprobes, iprobes          : Integer;
    succ_searches, unsucc_searches   : Integer;
    bsucc_probes, bunsucc_probes     : Integer;
    isucc_probes, iunsucc_probes     : Integer;
begin
    succ_searches := 0;
    unsucc_searches := 0;
    bsucc_probes := 0;
    bunsucc_probes := 0;
    isucc_probes := 0;
    iunsucc_probes := 0;
    for trial := 1 to MaxValue do
    begin
        status := HashTable.LocateItem(trial, bprobes, iprobes);
        if (status = bktFound) then
        begin
            succ_searches := succ_searches + 1;
            bsucc_probes := bsucc_probes + bprobes;
            isucc_probes := isucc_probes + iprobes;
        end else begin
            unsucc_searches := unsucc_searches + 1;
            bunsucc_probes := bunsucc_probes + bprobes;
            iunsucc_probes := iunsucc_probes + iprobes;
        end;
    end;

    if (succ_searches <= 0) then succ_searches := 1;
    bave_succ := bsucc_probes / succ_searches;
    iave_succ := isucc_probes / succ_searches;

    if (unsucc_searches <= 0) then unsucc_searches := 1;
    bave_unsucc := bunsucc_probes / unsucc_searches;
    iave_unsucc := iunsucc_probes / unsucc_searches;
end;

procedure TBucketForm.NumBucketsTextChange(Sender: TObject);
begin
    CmdCreateTable.Enabled :=
        ((NumBucketsText.Text <> '') and
         (BucketSizeText.Text <> ''));
end;

procedure TBucketForm.NewItemTextChange(Sender: TObject);
begin
    CmdAdd.Enabled := (NewItemText.Text <> '');
    CmdFind.Enabled := CmdAdd.Enabled;
end;

// Make the scroll box as wide as possible.
procedure TBucketForm.FormResize(Sender: TObject);
var
    wid : Integer;
begin
    wid := ClientWidth - TableScrollBox.Left;
    if (wid < 50) then wid := 50;
    TableScrollBox.Width := wid;
end;

end.
