unit HeurF;
//*******************************************************
// Example program demonstrating exhaustive, branch
// and bound, and heuristic 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, ExtCtrls;

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

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

  THeurForm = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    mnuExit: TMenuItem;
    Help1: TMenuItem;
    mnuAbout: TMenuItem;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    MinCostText: TEdit;
    MaxCostText: TEdit;
    MaxProfitText: TEdit;
    MinProfitText: TEdit;
    NumItemsText: TEdit;
    AllowedCostText: TEdit;
    Label6: TLabel;
    CmdGo: TButton;
    AlgCheck1: TCheckBox;
    RankLabel0: TLabel;
    ProfitLabel0: TLabel;
    CostLabel0: TLabel;
    TimeLabel0: TLabel;
    Bevel1: TBevel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure mnuExitClick(Sender: TObject);
    procedure mnuAboutClick(Sender: TObject);
    procedure CmdGoClick(Sender: TObject);
    procedure RandomizeData;
    procedure ClearSolutions;
    procedure ExhaustiveSearch(node : Integer);
    procedure BranchAndBound(node : Integer);
    procedure HillClimbing(node : Integer);
    procedure LeastCost(node : Integer);
    procedure BalancedProfit(node : Integer);
    function AddToSolution : Boolean;
    procedure RandomSearch(node : Integer);
    procedure RemoveFromSolution;
    procedure MakeChangesFixed(k, num_trials, num_changes : Integer);
    procedure Fixed1(node : Integer);
    procedure Fixed2(node : Integer);
    procedure MakeChangesNoChange(k, max_bad_trials, max_non_changes : Integer);
    procedure NoChange1(node : Integer);
    procedure NoChange2(node : Integer);
    procedure AnnealTrial(k, max_unchanged, max_slips : Integer);
    procedure Anneal(node : Integer);
  private
    { Private declarations }
    // Output labels.
    AlgCheck    : array[1..NUM_ALGS] of TCheckBox;
    RankLabel   : array[1..NUM_ALGS] of TLabel;
    ProfitLabel : array[1..NUM_ALGS] of TLabel;
    CostLabel   : array[1..NUM_ALGS] of TLabel;
    TimeLabel   : array[1..NUM_ALGS] of TLabel;

    // The algorithm procedures.
    Algorithms  : array [1..NUM_ALGS] of procedure(node : Integer) of object;

    // Item variables.
    NumItems         : Integer;
    Items            : PItemArray;
    AllowedCost      : Integer;

    // Search variables.
    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.
    TrialSolution    : PBoolArray; // Vraiables used by incremeental improvement heuristics.
    TrialCost        : Integer;
    TrialProfit      : Integer;

    Solutions        : array[1..NUM_ALGS] of Integer; // Solutions for each algorithm.

  public
    { Public declarations }
  end;

var
  HeurForm: THeurForm;

implementation

{$R *.DFM}

// Create output labels.
procedure THeurForm.FormCreate(Sender: TObject);
const
    DY = 24;
var
    i, x, y, wid : Integer;
begin
    Randomize;
    
    // Create the algorithm check boxes.
    AlgCheck[1] := AlgCheck1;
    x := AlgCheck1.Left;
    y := AlgCheck1.Top + DY;
    wid := AlgCheck1.Width;
    for i := 2 to NUM_ALGS do
    begin
        AlgCheck[i] := TCheckBox.Create(Self);
        with AlgCheck[i] do
        begin
            Parent := Self;
            Left := x;
            Top := y;
            Width := wid;
            Checked := True;
            Visible := True;
            y := y + DY;
        end;
    end;
    AlgCheck[2].Caption  := 'Branch and Bound';
    AlgCheck[3].Caption  := 'Hill Climbing';
    AlgCheck[4].Caption  := 'Least Cost';
    AlgCheck[5].Caption  := 'Balanced Profit';
    AlgCheck[6].Caption  := 'Random';
    AlgCheck[7].Caption  := 'Fixed 1';
    AlgCheck[8].Caption  := 'Fixed 2';
    AlgCheck[9].Caption  := 'No Change 1';
    AlgCheck[10].Caption := 'No Change 2';
    AlgCheck[11].Caption := 'Simulated Annealing';

    // Create the rank labels.
    x := RankLabel0.Left;
    y := AlgCheck[1].Top;
    wid := RankLabel0.Width;
    for i := 1 to NUM_ALGS do
    begin
        RankLabel[i] := TLabel.Create(Self);
        with RankLabel[i] do
        begin
            Parent := Self;
            Left := x;
            Top := y;
            Width := wid;
            Alignment := taRightJustify;
            Visible := True;
            y := y + DY;
        end;
    end;

    // Create the profit labels.
    x := ProfitLabel0.Left;
    y := AlgCheck[1].Top;
    wid := ProfitLabel0.Width;
    for i := 1 to NUM_ALGS do
    begin
        ProfitLabel[i] := TLabel.Create(Self);
        with ProfitLabel[i] do
        begin
            Parent := Self;
            Left := x;
            Top := y;
            Width := wid;
            Alignment := taRightJustify;
            Visible := True;
            y := y + DY;
        end;
    end;

    // Create the cost labels.
    x := CostLabel0.Left;
    y := AlgCheck[1].Top;
    wid := CostLabel0.Width;
    for i := 1 to NUM_ALGS do
    begin
        CostLabel[i] := TLabel.Create(Self);
        with CostLabel[i] do
        begin
            Parent := Self;
            Left := x;
            Top := y;
            Width := wid;
            Alignment := taRightJustify;
            Visible := True;
            y := y + DY;
        end;
    end;

    // Create the time labels.
    x := TimeLabel0.Left;
    y := AlgCheck[1].Top;
    wid := TimeLabel0.Width;
    for i := 1 to NUM_ALGS do
    begin
        TimeLabel[i] := TLabel.Create(Self);
        with TimeLabel[i] do
        begin
            Parent := Self;
            Left := x;
            Top := y;
            Width := wid;
            Alignment := taRightJustify;
            Visible := True;
            y := y + DY;
        end;
    end;

    // Create the list of algorithms.
    Algorithms[1]  := Self.ExhaustiveSearch;
    Algorithms[2]  := Self.BranchAndBound;
    Algorithms[3]  := Self.HillClimbing;
    Algorithms[4]  := Self.LeastCost;
    Algorithms[5]  := Self.BalancedProfit;
    Algorithms[6]  := Self.RandomSearch;
    Algorithms[7]  := Self.Fixed1;
    Algorithms[8]  := Self.Fixed2;
    Algorithms[9]  := Self.NoChange1;
    Algorithms[10] := Self.NoChange2;
    Algorithms[11] := Self.Anneal;
end;

// Free any dynamically allocated memory.
procedure THeurForm.FormDestroy(Sender: TObject);
begin
    if (NumItems > 0) then
    begin
        FreeMem(Items);
        FreeMem(BestSolution);
        FreeMem(TestSolution);
        FreeMem(TrialSolution);
    end;
end;

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

procedure THeurForm.mnuAboutClick(Sender: TObject);
const
    CRCR = #13#10#13#10;
begin
    MessageDlg(
        'This program uses exhaustive search, branch and bound, and several heuristics to find solutions to the knapsack problem.' + CRCR +
        'Enter values in the Parameters area to indicate how the data should be generated. Check the boxes next to the search methods you want the program to use. Then click the Go button to make the program search for solutions.' + CRCR +
        'Be sure you only use Branch and Bound for small problems (< 20) and exhaustive search for VERY small problems (< 15) until you know how long your computer will take.'
        , mtInformation, [mbOK], 0);
end;

// Start the algorithms.
procedure THeurForm.CmdGoClick(Sender: TObject);
var
    i, j, rank            : Integer;
    start_time, stop_time : TDateTime;
    h, m, s, ms           : Word;
begin
    Screen.Cursor := crHourGlass;
    RandomizeData;

    // Run the algorithms.
    for i := 1 to NUM_ALGS do
    begin
        Solutions[i] := -32767;
        if (AlgCheck[i].Checked) then
        begin
            ClearSolutions;
            start_time := Time;
            Algorithms[i](1);
            stop_time := Time;

            ProfitLabel[i].Caption := IntToStr(BestProfit);
            CostLabel[i].Caption := IntToStr(BestCost);
            DecodeTime(stop_time - start_time, h, m, s, ms);
            TimeLabel[i].Caption := Format('%.2f',
                [ms / 1000.0 + s + 60 * (m + h * 60)]);
            Refresh;
            Solutions[i] := BestProfit;
        end;
    end;

    // Rank the algorithms.
    for i := 1 to NUM_ALGS do
    begin
        if (AlgCheck[i].Checked) then
        begin
            rank := 1;
            for j := 1 to NUM_ALGS do
                if (Solutions[j] > Solutions[i]) then
                    rank := rank + 1;
            if (rank = 1) then
                AlgCheck[i].Color := clGray;
            RankLabel[i].Caption := IntToStr(rank);
        end;
    end;

    Screen.Cursor := crDefault;
end;

// Create random data.
procedure THeurForm.RandomizeData;
var
    min_cost, max_cost, min_profit, max_profit : Integer;
    i, cost_range, profit_range                : Integer;
begin
    // Initialize the Item and solution arrays.
    i := StrToInt(NumItemsText.Text);
    if (i <> NumItems) then
    begin
        if (NumItems > 0) then
        begin
            FreeMem(Items);
            FreeMem(BestSolution);
            FreeMem(TestSolution);
            FreeMem(TrialSolution);
        end;
        NumItems := i;
        GetMem(Items, NumItems * SizeOf(TItem));
        GetMem(BestSolution, NumItems * SizeOf(Boolean));
        GetMem(TestSolution, NumItems * SizeOf(Boolean));
        GetMem(TrialSolution, NumItems * SizeOf(Boolean));
    end;

    AllowedCost := StrToInt(AllowedCostText.Text);
    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;
    for i := 1 to NumItems do
    begin
        with Items[i] do
        begin
            Cost := min_cost + Random(cost_range);
            Profit := min_profit + Random(profit_range);
        end;
    end;

    // Clear the output labels.
    for i := 1 to NUM_ALGS do
    begin
        RankLabel[i].Caption := '';
        ProfitLabel[i].Caption := '';
        CostLabel[i].Caption := '';
        TimeLabel[i].Caption := '';
        AlgCheck[i].Color := Color;
    end;
    Refresh;
end;

// Reset the TestSolution and BestSolution for the
// next algorithm.
procedure THeurForm.ClearSolutions;
var
    i : Integer;
begin
    BestProfit := 0;
    BestCost := 0;
    TestProfit := 0;
    TestCost := 0;
    TrialProfit := 0;
    TrialCost := 0;
    for i := 1 to NumItems do
    begin
        BestSolution[i] := False;
        TestSolution[i] := False;
    end;

    UnassignedProfit := 0;
    for i := 1 to NumItems do
        UnassignedProfit := UnassignedProfit +
            Items[i].Profit;
end;

// Exhaustively search the tree for the best solution
// starting with this item.
procedure THeurForm.ExhaustiveSearch(node : Integer);
var
    i : Integer;
begin
    if (node > NumItems) then
    begin
        // This is a leaf node. Evaluate the solution.
        if ((TestCost <= AllowedCost) and
            (TestProfit > BestProfit)) then
        begin
            for i := 1 to NumItems do
            begin
                BestSolution[i] := TestSolution[i];
                BestProfit := TestProfit;
                BestCost := TestCost;
            end;
        end;
    end else begin
        // It's not a leaf node. Recursively descend.
        // Include this item.
        TestSolution[node] := True;
        TestCost := TestCost + Items[node].Cost;
        TestProfit := TestProfit + Items[node].Profit;
        ExhaustiveSearch(node + 1);

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

// Search the tree for the best solution using Branch and
// Bound starting with this item.
procedure THeurForm.BranchAndBound(node : Integer);
var
    i : Integer;
begin
    // 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 (node > 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[node].Cost <= AllowedCost) then
    begin
        // Add the item to the test solution.
        TestSolution[node] := True;
        TestCost := TestCost + Items[node].Cost;
        TestProfit := TestProfit + Items[node].Profit;
        UnassignedProfit := UnassignedProfit - Items[node].Profit;

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

        // Remove the item from the test solution.
        TestSolution[node] := False;
        TestCost := TestCost - Items[node].Cost;
        TestProfit := TestProfit - Items[node].Profit;
        UnassignedProfit := UnassignedProfit + Items[node].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[node].Profit;
    if (TestProfit + UnassignedProfit > BestProfit) then
        BranchAndBound(node + 1);
    UnassignedProfit := UnassignedProfit + Items[node].Profit;
end;

// Search the tree using a hill climbing heuristic.
procedure THeurForm.HillClimbing(node : Integer);
var
    i, j, big_value, big_j : Integer;
begin
    // Repeatedly pass through the list looking for the
    // remaining item with the largest profit that fits
    // within the cost bounds.
    for i := 1 to NumItems do
    begin
        big_value := 0;
        big_j := -1;
        for j := 1 to NumItems do
            // Make sure it is not already in the solution.
            if ((not BestSolution[j]) and
                (big_value < Items[j].Profit) and
                (BestCost + Items[j].Cost <= AllowedCost))
            then begin
                big_value := Items[j].Profit;
                big_j := j;
            end;

        // Stop when no more items fit.
        if (big_j < 0) then break;

        // Add the selected item to the solution.
        BestCost := BestCost + Items[big_j].Cost;
        BestSolution[big_j] := True;
        BestProfit := BestProfit + Items[big_j].Profit;
    end; // End for i := 1 to NumItems do...
end;

// Search the tree using a least cost heuristic.
procedure THeurForm.LeastCost(node : Integer);
var
    i, j, small_cost, small_j : Integer;
begin
    // Repeatedly pass through the list looking for the
    // remaining item with the least cost that fits
    // within the cost bounds.
    for i := 1 to NumItems do
    begin
        small_cost := 32767;
        small_j := -1;
        for j := 1 to NumItems do
            // Make sure it is not already in the solution.
            if ((not BestSolution[j]) and
                (small_cost > Items[j].Cost) and
                (BestCost + Items[j].Cost <= AllowedCost))
            then begin
                small_cost := Items[j].Cost;
                small_j := j;
            end;

        // Stop when no more items fit.
        if (small_j < 0) then break;

        BestCost := BestCost + Items[small_j].Cost;
        BestSolution[small_j] := True;
        BestProfit := BestProfit + Items[small_j].Profit;
    end;
end;

// Search the tree using a balanced profit heuristic.
procedure THeurForm.BalancedProfit(node : Integer);
var
    i, j, good_j             : Integer;
    test_ratio, good_ratio   : Single;
begin
    // Repeatedly pass through the list looking for the
    // remaining item with the largest profit/cost ratio
    // that fits within the cost bounds.
    for i := 1 to NumItems do
    begin
        good_ratio := 0.0;
        good_j := -1;
        // Find the unused item with the largest
        // profit/cost ratio that still fits in
        // the solution.
        for j := 1 to NumItems do
        begin
            // Make sure it is not already in the solution.
            test_ratio := Items[j].Profit / Items[j].Cost;
            if ((not BestSolution[j]) and
                (good_ratio < test_ratio) and
                (BestCost + Items[j].Cost <= AllowedCost))
            then begin
                good_ratio := test_ratio;
                good_j := j;
            end;
        end;

        // Stop when no more items fit.
        if (good_j < 0) then break;

        BestCost := BestCost + Items[good_j].Cost;
        BestSolution[good_j] := True;
        BestProfit := BestProfit + Items[good_j].Profit;
    end;
end;

// Add a random item to the test solution. Return True if
// successful, False if no more items will fit.
function THeurForm.AddToSolution : Boolean;
var
    num_left, j, selection : Integer;
begin
    // See how many items remain that will fit within
    // the cost bound.
    num_left := 0;
    for j := 1 to NumItems do
        if ((not TestSolution[j]) and
            (TestCost + Items[j].Cost <= AllowedCost)) then
                num_left := num_left + 1;

    // Stop when no items fit.
    Result := (num_left > 0);
    if (not Result) then exit;

    // Pick one of the items that fit at random.
    selection := Random(num_left - 1) + 1;

    // Find the chosen item.
    for j := 1 to NumItems do
        if ((not TestSolution[j]) and
            (TestCost + Items[j].Cost <= AllowedCost)) then
        begin
            selection := selection - 1;
            if (selection < 1) then break;
        end;

    TestProfit := TestProfit + Items[j].Profit;
    TestCost := TestCost + Items[j].Cost;
    TestSolution[j] := True;
end;

// Search the tree using a random heuristic.
procedure THeurForm.RandomSearch(node : Integer);
var
    num_trials, trial, i : Integer;
begin
    // Make several trials and keep the best.
    num_trials := NumItems;
    for trial := 1 to num_trials do
    begin
        // Make random selections until no more items fit.
        while (AddToSolution) do ;

        // See if this solution is an improvement.
        if (TestProfit > BestProfit) then
        begin
            BestProfit := TestProfit;
            BestCost := TestCost;
            for i := 1 to NumItems do
                BestSolution[i] := TestSolution[i];
        end;

        // Reset the test solution for the next trial.
        TestProfit := 0;
        TestCost := 0;
        for i := 1 to NumItems do
            TestSolution[i] := False;
    end; // End for trial := 1 to num_trials do...
end;

// Remove a random item from the test solution.
procedure THeurForm.RemoveFromSolution;
var
    num, j, selection : Integer;
begin
    // See how many items are in the solution.
    num := 0;
    for j := 1 to NumItems do
        if (TestSolution[j]) then
            num := num + 1;
    if (num < 1) then exit;

    // Pick one at random.
    selection := Random(num) + 1;

    // Find the randomly chosen item.
    for j := 1 to NumItems do
        if (TestSolution[j]) then
        begin
            selection := selection - 1;
            if (selection < 1) then break;
        end;

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

// Switch K items at a time to improve the test solution.
// Run num_trials trials making num_changes changes
// during each.
procedure THeurForm.MakeChangesFixed(k, num_trials, num_changes : Integer);
var
    trial, change, i, removal : Integer;
begin
    for trial := 1 to num_trials do
    begin
        // Find a random test solution to start from.
        while (AddtoSolution) do ;

        // Start with this as the trial solution.
        TrialProfit := TestProfit;
        TrialCost := TestCost;
        for i := 1 to NumItems do
            TrialSolution[i] := TestSolution[i];

        for change := 1 to num_changes do
        begin
            // Remove k random items.
            for removal := 1 to k do
                RemoveFromSolution;

            // Add back as many random items as will fit.
            while (AddtoSolution) do ;

            // If this improves the trial, save it.
            // Otherwise reset the trial to its
            // previous value.
            if (TestProfit > TrialProfit) then
            begin
                // Save the improvement.
                TrialProfit := TestProfit;
                TrialCost := TestCost;
                for i := 1 to NumItems do
                    TrialSolution[i] := TestSolution[i];
            end else begin
                // Reset the trial.
                TestProfit := TrialProfit;
                TestCost := TrialCost;
                for i := 1 to NumItems do
                    TestSolution[i] := TrialSolution[i];
            end;
        end; // End for change := 1 to num_changes do...

        // If this trial is better than the best solution
        // so far, save it.
        if (TrialProfit > BestProfit) then
        begin
            BestProfit := TrialProfit;
            BestCost := TrialCost;
            for i := 1 to NumItems do
                BestSolution[i] := TrialSolution[i];
        end;

        // Reset the test solution for the next trial.
        TestProfit := 0;
        TestCost := 0;
        for i := 1 to NumItems do
            TestSolution[i] := False;
    end; // End for trial := 1 to num_trials do...
end;

// Search the tree using an incremental improvement
// heuristic that makes N trials of 2 * N one item changes.
procedure THeurform.Fixed1(node : Integer);
begin
    MakeChangesFixed(1, NumItems, 2 * NumItems);
end;

// Search the tree using an incremental improvement
// heuristic that makes 1 trial of 10 * N two item changes.
procedure THeurform.Fixed2(node : Integer);
begin
    MakeChangesFixed(2, 1, 10 * NumItems);
end;

// Switch k items at a time to improve the test solution.
// Repeat trials until we have max_bad_trials runs in a
// row with no improvement.
//
// During each trial, try random changes until we try
// max_non_changes in a row with no improvement.
procedure THeurform.MakeChangesNoChange(k, max_bad_trials, max_non_changes : Integer);
var
    i, removal  : Integer;
    bad_trials  : Integer; // # consecutive ineffective trials.
    non_changes : Integer; // # consecutive ineffective-changes.
begin
    // Repeat trials until we have max_bad_trials
    // runs in a row without an improvement.
    bad_trials := 0;
    repeat
        // Find a random test solution to start from.
        while (AddtoSolution) do ;

        // Start with this as the trial solution.
        TrialProfit := TestProfit;
        TrialCost := TestCost;
        for i := 1 to NumItems do
            TrialSolution[i] := TestSolution[i];

        // Repeat until we try max_non_changes in a row
        // with no improvement.
        non_changes := 0;
        while (non_changes < max_non_changes) do
        begin
            // Remove k random items.
            for removal := 1 to k do
                RemoveFromSolution;

            // Add back as many random items as will fit.
            while (AddtoSolution) do ;

            // If this improves the trial, save it.
            // Otherwise reset the trial to its
            // previous value.
            if (TestProfit > TrialProfit) then
            begin
                // Save the improvement.
                TrialProfit := TestProfit;
                TrialCost := TestCost;
                for i := 1 to NumItems do
                    TrialSolution[i] := TestSolution[i];
                non_changes := 0; // This was a good change.
            end else begin
                // Reset the trial.
                TestProfit := TrialProfit;
                TestCost := TrialCost;
                for i := 1 to NumItems do
                    TestSolution[i] := TrialSolution[i];
                non_changes := non_changes + 1; // Bad change.
            end;
        end; // End while trying changes

        // If this trial is better than the best solution
        // so far, save it.
        if (TrialProfit > BestProfit) then
        begin
            BestProfit := TrialProfit;
            BestCost := TrialCost;
            for i := 1 to NumItems do
                BestSolution[i] := TrialSolution[i];
            bad_trials := 0; // This was a good trial.
        end else
            bad_trials := bad_trials + 1; // Bad trial.

        // Reset the test solution for the next trial.
        TestProfit := 0;
        TestCost := 0;
        for i := 1 to NumItems do
            TestSolution[i] := False;
    until (bad_trials >= max_bad_trials);
end;

// Search the tree using an incremental improvement
// heuristic that makes trials until it has N trials in a
// row with no improvement. Each trial makes one item
// changes until it has N changes in a row with no improvement.
procedure THeurform.NoChange1(node : Integer);
begin
    MakeChangesNoChange(1, NumItems, NumItems);
end;

// Search the tree using an incremental improvement
// heuristic that make one trial. The trial makes two item
// changes until it has N changes in a row with no improvement.
procedure THeurform.NoChange2(node : Integer);
begin
    MakeChangesNoChange(2, 0, NumItems);
end;

// Switch k items at a time to improve the test solution.
// When this gives an improvement, save the change.
// Otherwise save the change anyway with some probability.
// After max_slips saves anyway, decrease t.
// After max_unchanged unsaved changes, stop.
procedure THeurform.AnnealTrial(k, max_unchanged, max_slips : Integer);
const
    TFACTOR = 0.8;
var
    i, removal, num_unchanged, num_slips : Integer;
    max_profit, min_profit               : Integer;
    save_changes, slipped                : Boolean;
    t                                    : Single;
begin
    // Find the largest and smallest profits.
    max_profit := Items[1].Profit;
    min_profit := max_profit;
    for i := 2 to NumItems do
    begin
        if (max_profit <  Items[i].Profit) then
            max_profit := Items[i].Profit;
        if (min_profit >  Items[i].Profit) then
            min_profit := Items[i].Profit;
    end;

    // Initialize t.
    t := 0.75 * (max_profit - min_profit);

    // Find a random test solution to start from.
    while (AddtoSolution) do ;

    // Start with this as the best solution.
    BestProfit := TestProfit;
    BestCost := TestCost;
    for i := 1 to NumItems do
        BestSolution[i] := TestSolution[i];

    // Repeat until we try max_unchanged in a row
    // with no improvement.
    num_slips := 0;
    num_unchanged := 0;
    while (num_unchanged < max_unchanged) do
    begin
        // Remove k random items.
        for removal := 1 to k do
            RemoveFromSolution;

        // Add back as many random items as will fit.
        while (AddtoSolution) do ;

        // See if this is an improvement.
        if (TestProfit > BestProfit) then
        begin
            save_changes := True;
            slipped := False;
        end else if (TestProfit = BestProfit) then
        begin
            // The probability equation would give 1.
            save_changes := False;
            slipped := False;
        end else begin
            // See if we should save the change anyway.
            save_changes := (Random <
                Exp((TestProfit - BestProfit) / t));
            slipped := save_changes;
        end;

        // See if we should save the solution.
        if (save_changes) then
        begin
            // Save the new solution.
            BestProfit := TestProfit;
            BestCost := TestCost;
            for i := 1 to NumItems do
                BestSolution[i] := TestSolution[i];
            num_unchanged := 0; // We saved a change.
        end else begin
            // Restore the previous solution.
            TestProfit := BestProfit;
            TestCost := BestCost;
            for i := 1 to NumItems do
                TestSolution[i] := BestSolution[i];
            num_unchanged := num_unchanged + 1;
        end;

        // See if we slipped (made an unimproving save).
        if (slipped) then
        begin
            num_slips := num_slips + 1;
            if (num_slips > max_slips) then
            begin
                num_slips := 0;
                t := t * TFACTOR;
                num_unchanged := 0;
            end;
        end;
    end; // Try again.
end;

// Search the tree using a simulated annealing heuristic.
// Make one trials. Replace two items at a time. Each time
// we save N changes that do not improve the solution,
// reduce the temperature variable t. When we find N * N
// changes in a row that are not saved, either because they
// improve the solution or due to random saves, stop.
procedure THeurform.Anneal(node : Integer);
begin
    AnnealTrial(2, NumItems * NumItems, NumItems);
end;

end.
