Algorithm Alley
by Rod Stephens

Listing One
Dim Values() As Long
Dim NumValues As Integer

Dim BestSolution() As Integer
Dim TestSolution() As Integer
Dim BestDifference As Long
Dim TestDifference As Long
Dim Total(1 To 2) As Long

' *********************************************
' Search exhaustively considering the indicated node.

Private Sub ExhaustiveSearch(node As Integer)
Dim i As Integer
Dim bin As Integer
Dim diff As Long
    NodesVisited = NodesVisited + 1
    ' See if we have assigned every node in the test solution.
    If node > NumValues Then
        ' See if this test solution is better than the previous best solution.
        Total(1) = 0
        Total(2) = 0
        For i = 1 To NumValues
            bin = TestSolution(i)
            Total(bin) = Total(bin) + Values(i)
        Next i
        diff = Abs(Total(2) - Total(1))
        If diff < BestDifference Then
            ' Save the improved solution.
            For i = 1 To NumValues
                BestSolution(i) = TestSolution(i)
            Next i
            BestDifference = diff
        End If
        Exit Sub
    End If
    ' Recursively see what would happen if we add the next item to bin 1.
    TestSolution(node) = 1
    ExhaustiveSearch node + 1
    ' Recursively see what would happen if we add the next item to bin 2.
    TestSolution(node) = 2
    ExhaustiveSearch node + 1
End Sub

Listing Two
Dim UnusedValues As Long
' *********************************************
' Search using branch and bound considering the indicated node.

Private Sub BranchAndBound(node As Integer)
Dim i As Integer
Dim bin As Integer
Dim value As Long
    NodesVisited = NodesVisited + 1
    ' See if we have assigned every node in the test solution.
    If node > NumValues Then
        ' This must be better than the previous best solution or we would 
        ' not have come here. Save the solution.
        BestDifference = Abs(Total(2) - Total(1))
        For i = 1 To NumValues
            BestSolution(i) = TestSolution(i)
        Next i
        Exit Sub
    End If
    ' See what would happen if we add the item to each of the bins.
    value = Values(node)
    For bin = 1 To 2
        ' Add the item to this test bin.
        TestSolution(node) = bin
        Total(bin) = Total(bin) + value
        UnusedValues = UnusedValues - value
        ' See if it would still be possible to improve current best solution.
        If Abs(Total(2) - Total(1)) - UnusedValues < BestDifference Then
            ' It is possible. Recursively explore this solution further.
            BranchAndBound node + 1
        End If
        ' Remove the item from the test bin.
        Total(bin) = Total(bin) - value
        UnusedValues = UnusedValues + value
    Next bin
End Sub

Listing Three
' *********************************************
' Generate a solution heuristically. At each step add the largest 
' unassigned item to the list with the smaller total.
Private Sub HillClimbing()
Dim i As Integer
Dim j As Integer
Dim best_j As Integer
Dim best_value As Long
    ' Assign the ith largest item.
    For i = 1 To NumValues
        NodesVisited = NodesVisited + 1
        ' Find the ith largest item rather inefficiently.
        best_value = -1000000000
        For j = 1 To NumValues
            If BestSolution(j) = 0 And _
                Values(j) > best_value _
            Then
                best_value = Values(j)
                best_j = j
            End If
        Next j
        ' Assign the item to the emptier bin.
        If Total(1) < Total(2) Then
            BestSolution(best_j) = 1
            Total(1) = Total(1) + best_value
        Else
            BestSolution(best_j) = 2
            Total(2) = Total(2) + best_value
        End If
    Next i
    BestDifference = Abs(Total(2) - Total(1))
End Sub


Listing Four
' *********************************************
' Generate random solutions until we have max_the_same in 
' a row that produce no improvement.

Private Sub RandomSearch(max_the_same As Long)
Dim num_the_same As Long
Dim i As Integer
Dim bin As Integer
Dim diff As Long
    ReDim ordering(1 To NumValues)
    ' Generate random solutions.
    Do While num_the_same <= max_the_same
        Total(1) = 0
        Total(2) = 0
        ' Generate a random solution.
        For i = 1 To NumValues
            bin = Int(2 * Rnd + 1)
            TestSolution(i) = bin
            Total(bin) = Total(bin) + Values(i)
            NodesVisited = NodesVisited + 1
        Next i
        ' See if this test solution is better than the previous best solution.
        diff = Abs(Total(2) - Total(1))
        If diff < BestDifference Then
            ' Save the improved solution.
            For i = 1 To NumValues
                BestSolution(i) = TestSolution(i)
            Next i
            BestDifference = diff
            num_the_same = 0
        Else
            num_the_same = num_the_same + 1
        End If
    Loop
End Sub


Listing Five
' *********************************************
' Generate random solutions. Improve them until we have same_per_trial 
' in a row with no improvement. Repeat until we have same_trials in a row 
' with no improvement.
' *********************************************
Private Sub IncrementalImprovement(same_trials As Long, same_per_trial As Long)
Dim trials_the_same As Long

Dim impr_the_same As Long
Dim i As Integer
Dim j As Integer
Dim bin As Integer
Dim diff As Long
Dim test_diff As Long
Dim test_total(1 To 2) As Long
Dim num_in_bin(1 To 2) As Integer
Dim num As Integer
    ReDim ordering(1 To NumValues)
    ' Generate random solutions.
    Do While trials_the_same <= same_trials
        Total(1) = 0
        Total(2) = 0
        num_in_bin(1) = 0
        num_in_bin(2) = 0
        ' Generate a random solution.
        For i = 1 To NumValues
            bin = Int(2 * Rnd + 1)
            TestSolution(i) = bin
            Total(bin) = Total(bin) + Values(i)
            num_in_bin(bin) = num_in_bin(bin) + 1
            NodesVisited = NodesVisited + 1
        Next i
        diff = Abs(Total(2) - Total(1))
        ' Generate random improvements.
        If num_in_bin(1) = 0 Or num_in_bin(2) = 0 Then
            impr_the_same = same_per_trial + 1
        Else
            impr_the_same = 0
        End If
        Do While impr_the_same <= same_per_trial
            ' Pick an item in bin 1.
            num = Int(num_in_bin(1) * Rnd + 1)
            For i = 1 To NumValues
                If TestSolution(i) = 1 Then
                    num = num - 1
                    If num <= 0 Then Exit For
                End If
            Next i
            ' Pick an item in bin 2.
            num = Int(num_in_bin(2) * Rnd + 1)
            For j = 1 To NumValues
                If TestSolution(j) = 2 Then
                    num = num - 1
                    If num <= 0 Then Exit For
                End If
            Next j
            NodesVisited = NodesVisited + 2
            ' See if the swap would help.
            test_total(1) = Total(1) - Values(i) + Values(j)
            test_total(2) = Total(2) - Values(j) + Values(i)
            test_diff = Abs(test_total(2) - test_total(1))
            If test_diff < diff Then
                ' It helps.
                diff = test_diff
                Total(1) = test_total(1)
                Total(2) = test_total(2)
                TestSolution(i) = 2
                TestSolution(j) = 1
                impr_the_same = 0
            Else
                ' No improvement.
                impr_the_same = impr_the_same + 1
            End If
        Loop    ' End improving this solution.
        ' See if this test solution is better than previous best solution.
        diff = Abs(Total(2) - Total(1))
        If diff < BestDifference Then
            ' Save the improved solution.
            For i = 1 To NumValues
                BestSolution(i) = TestSolution(i)
            Next i
            BestDifference = diff
            trials_the_same = 0
        Else
            trials_the_same = trials_the_same + 1
        End If
    Loop
End Sub


4


