unit BandBF;
//*******************************************************
// Example program demonstrating exhaustive and branch
// and bound searching.
//*******************************************************
// 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,
  Math;

const
    CR = #13#10;

type
  TItem = record
    Cost   : Integer;
    Profit : Integer;
  end;
  TItemArray = array [1..1000000] of TItem;
  PItemArray = ^TItemArray;

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

  TBandBForm = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    mnuExit: TMenuItem;
    Help1: TMenuItem;
    mnuAbout: TMenuItem;
    GroupBox1: TGroupBox;
    MinCostText: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    MaxCostText: TEdit;
    MaxProfitText: TEdit;
    MinProfitText: TEdit;
    Label4: TLabel;
    Label5: TLabel;
    NumItemsText: TEdit;
    CmdMakeData: TButton;
    GroupBox2: TGroupBox;
    Label6: TLabel;
    AllowedCostText: TEdit;
    OptExhaustiveSearch: TRadioButton;
    OptBranchAndBound: TRadioButton;
    CmdGo: TButton;
    ScrollBox1: TScrollBox;
    Label7: TLabel;
    ScrollBox2: TScrollBox;
    Label8: TLabel;
    ValuesLabel: TLabel;
    SolutionLabel: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    NodesLabel: TLabel;
    VisitedLabel: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    BestCostLabel: TLabel;
    BestProfitLabel: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure mnuExitClick(Sender: TObject);
    procedure mnuAboutClick(Sender: TObject);
    procedure CmdMakeDataClick(Sender: TObject);
    procedure CmdGoClick(Sender: TObject);
    procedure ShowResults;
    procedure Search(b_and_b : Boolean);
    procedure BranchAndBound(item_num : Integer);
    procedure ExhaustiveSearch(item_num : Integer);
  private
    { Private declarations }
    NumItems         : Integer;
    Items            : PItemArray;
    AllowedCost      : Integer;

    // Search variables.
    NodesVisited     : Longint;
    UnassignedProfit : Integer;    // Total of unassigned profits.
    BestSolution     : PBoolArray; // True for items in best solution.
    BestCost         : Integer;
    BestProfit       : Integer;
    TestSolution     : PBoolArray; // True for items in test solution.
    TestCost         : Integer;    // Cost of test solution.
    TestProfit       : Integer;    // Profit of test solution.

  public
    { Public declarations }
  end;

var
  BandBForm: TBandBForm;

implementation

{$R *.DFM}

procedure TBandBForm.FormCreate(Sender: TObject);
begin
    Randomize;
end;

procedure TBandBForm.mnuExitClick(Sender: TObject);
begin
    Close;
end;

procedure TBandBForm.mnuAboutClick(Sender: TObject);
const
    CRCR = #13#10#13#10;
begin
    MessageDlg(
        'This program uses an exhaustive or branch and bound search to find the best solution to the knapsack problem.' + CRCR +
        'Enter values in the Parameters area and click the Randomize button to make the program generate random data.' + CRCR +
        'Select exhaustive or branch and bound search using the option buttons. Then click the Go button and the program will perform the search.' + CRCR +
        'Do not perform large exhaustive searches until you know how your computer will perform. One or two additional items can make a big difference in run time.'
        , mtInformation, [mbOK], 0);
end;

// Generate some random data.
procedure TBandBForm.CmdMakeDataClick(Sender: TObject);
var
    min_cost, max_cost, min_profit, max_profit : Integer;
    i, cost_range, profit_range                : Integer;
    txt                                        : String;
begin
    // Initialize the Item and solution arrays.
    if (NumItems > 0) then
    begin
        FreeMem(Items);
        FreeMem(TestSolution);
        FreeMem(BestSolution);
    end;
    NumItems := StrToInt(NumItemsText.Text);
    GetMem(Items, NumItems * SizeOf(TItem));
    GetMem(TestSolution, NumItems * SizeOf(Boolean));
    GetMem(BestSolution, NumItems * SizeOf(Boolean));

    min_cost := StrToInt(MinCostText.Text);
    max_cost := StrToInt(MaxCostText.Text);
    min_profit := StrToInt(MinProfitText.Text);
    max_profit := StrToInt(MaxProfitText.Text);

    cost_range := max_cost - min_cost + 1;
    profit_range := max_profit - min_profit + 1;
    txt := ' Cost   Profit' + CR + '------  ------' + CR;
    for i := 1 to NumItems do
    begin
        with Items[i] do
        begin
            Cost := min_cost + Random(cost_range);
            Profit := min_profit + Random(profit_range);
            txt := txt +
                Format('%6d  %6d', [Cost, Profit]) + CR;
        end;
    end;
    ValuesLabel.Caption := txt;
    NodesLabel.Caption :=
        IntToStr(Round(Power(2, (NumItems + 1)) - 1));

    // Clear the previous solution.
    SolutionLabel.Caption := '';
    BestCostLabel.Caption := '';
    BestProfitLabel.Caption := '';
    VisitedLabel.Caption := '';

    CmdGo.Enabled := True;
end;

// Start the search.
procedure TBandBForm.CmdGoClick(Sender: TObject);
begin
    Screen.Cursor := crHourGlass;

    // Get ToSpend and prepare labels.
    AllowedCost := StrToInt(AllowedCostText.Text);
    SolutionLabel.Caption := '';
    BestProfitLabel.Caption := '';
    BestCostLabel.Caption := '';
    VisitedLabel.Caption := '';
    Refresh;

    Search(OptBranchAndBound.Checked);
    ShowResults;

    Screen.Cursor := crDefault;
end;

// Display the results of the search.
procedure TBandBForm.ShowResults;
var
    i   : Integer;
    txt : String;
begin
    txt := ' Cost   Profit' + CR + '------  ------' + CR;
    for i := 1 to NumItems do
        if (BestSolution[i]) then
            txt := txt + Format('%6d  %6d',
                [Items[i].Cost, Items[i].Profit]) + CR;
    SolutionLabel.Caption := txt;

    BestCostLabel.Caption := IntToStr(BestCost);
    BestProfitLabel.Caption := IntToStr(BestProfit);
    VisitedLabel.Caption := IntToStr(NodesVisited);
end;

// Initialize test values and start an exhaustve or
// branch and bound search.
procedure TBandBForm.Search(b_and_b : Boolean);
var
    i : Integer;
begin
    NodesVisited := 0;
    BestProfit := 0;
    BestCost := 0;
    TestProfit := 0;
    TestCost := 0;
    UnassignedProfit := 0;
    for i := 1 to NumItems do
        UnassignedProfit := UnassignedProfit +
            Items[i].Profit;

    // Start the search with the first item.
    if (b_and_b) then
        BranchAndBound(1)
    else
        ExhaustiveSearch(1);
end;

// Perform a branch and bound search starting with
// the indicated item.
procedure TBandBForm.BranchAndBound(item_num : Integer);
var
    i : Integer;
begin
    NodesVisited := NodesVisited + 1;

    // If this is a leaf node, it must be a better
    // solution than we have so far or it would have been
    // cut off earlier in the search.
    if (item_num > NumItems) then
    begin
        // Save the improved solution.
        for i := 1 to NumItems do
            BestSolution[i] := TestSolution[i];
        BestProfit := TestProfit;
        BestCost := TestCost;
        exit;
    end;

    // Otherwise descend down the child branches. First
    // try including this item making sure it fits within
    // the cost bound.
    if (TestCost + Items[item_num].Cost <= AllowedCost) then
    begin
        // Add the item to the test solution.
        TestSolution[item_num] := True;
        TestCost := TestCost + Items[item_num].Cost;
        TestProfit := TestProfit + Items[item_num].Profit;
        UnassignedProfit := UnassignedProfit - Items[item_num].Profit;

        // Recursively see what the result might be.
        BranchAndBound(item_num + 1);

        // Remove the item from the test solution.
        TestSolution[item_num] := False;
        TestCost := TestCost - Items[item_num].Cost;
        TestProfit := TestProfit - Items[item_num].Profit;
        UnassignedProfit := UnassignedProfit + Items[item_num].Profit;
    end;

    // Try excluding the item. See if the remaining items
    // have enough profit to make a path down this branch
    // reach our lower bound.
    UnassignedProfit := UnassignedProfit - Items[item_num].Profit;
    if (TestProfit + UnassignedProfit > BestProfit) then
        BranchAndBound(item_num + 1);
    UnassignedProfit := UnassignedProfit + Items[item_num].Profit;
end;

// Exhaustively search the tree for the best solution
// starting with this item.
procedure TBandBForm.ExhaustiveSearch(item_num : Integer);
var
    i : Integer;
begin
    NodesVisited := NodesVisited + 1;

    if (item_num > NumItems) then
    begin
        // This is a leaf node. Evaluate our success.
        if ((TestCost <= AllowedCost) and
            (TestProfit > BestProfit)) then
        begin
            for i := 1 to NumItems do
                BestSolution[i] := TestSolution[i];
            BestProfit := TestProfit;
            BestCost := TestCost;
        end;
    end else begin
        // This is not a leaf node. Recursively descend.
        // Try including this item.
        TestSolution[item_num] := True;
        TestCost := TestCost + Items[item_num].Cost;
        TestProfit := TestProfit + Items[item_num].Profit;
        ExhaustiveSearch(item_num + 1);

        // Try excluding the item.
        TestSolution[item_num] := False;
        TestCost := TestCost - Items[item_num].Cost;
        TestProfit := TestProfit - Items[item_num].Profit;
        ExhaustiveSearch(item_num + 1);
    end;
end;

end.
