b_HyperHeuristic.txt

Option Explicit
Sub HyperHeuristic(ByVal InputShtName As String, ByRef Domain() As Integer, ByVal MaxNumImprovements As Long, ByVal ShowAllImprovements As Boolean, ByVal FormulationMethod As String, ByVal FormulationDetails As String, ByVal HHFreqAttempts As Integer, ByRef FrequencyListAndPopularities() As Integer, ByVal NumOfRequests As Integer, ByVal NumOfFrequencies As Integer, ByVal InitialCost As Double, ByVal StartProbA As Single, ByVal StartProbB As Single, ByVal StartProbC As Single, ByVal StartProbD As Single)
    Dim InitialNumFrequenciesUsed As Integer
    Dim i As Integer
    Dim j As Integer
    Dim Improvement As Long
    Dim Iteration As Long
    
    Dim CurrentCost As Double
    Dim NewCost As Double
    Dim NewNumFrequenciesUsed As Integer
    Dim FullAttempts As Long
    Dim RandomNumber As Single
    Dim ProbA As Single
    Dim ProbB As Single
    Dim ProbC As Single
    Dim ProbD As Single
    Dim APerformance(1 To 2) As Long 'Stores successes 1, failures in 2
    Dim BPerformance(1 To 2) As Long
    Dim CPerformance(1 To 2) As Long
    Dim DPerformance(1 To 2) As Long
    'Print Initial Popularities
    InitialNumFrequenciesUsed = CountFrequenciesUsed_2D(FrequencyListAndPopularities)
    InitialCost = Cost(FrequencyListAndPopularities)
    
    
    Call PreparePopularitiesSheet(InitialNumFrequenciesUsed, InitialCost, FrequencyListAndPopularities())
           
    Dim FailedIterations As Integer
    Dim ResultA As Boolean
    Dim ResultB As Boolean
    Dim ResultC As Boolean
    Dim ResultD As Boolean
    Dim CurrentHeuristic As String
    Dim NumOfFrequenciesUsed As Integer
    Dim LowerBound As Integer
    
    
    ProbA = StartProbA
    ProbB = StartProbB
    ProbC = StartProbC
    ProbD = StartProbD
    Call PrepareHeuristicPerformanceSheets(ProbA, ProbB, ProbC, ProbD)
    
    
    MaxHHAttempts = HHFreqAttempts
    
    Iteration = 0
    Improvement = 0
    Dim txt1 As String
    Dim txt2 As String
    Dim txt3 As String
    
    If IsNumeric(Sheets("RunProgram").Range("C30").Value) = True Then
    LowerBound = Sheets("RunProgram").Range("C30").Value
    Else
    LowerBound = 0
    End If
    
    Call PrintImprToAssignmentANDPopsSheets(Domain, FrequencyListAndPopularities(), 0, InitialCost, "", "", "", NumOfFrequencies, NumOfRequests, NumOfFrequenciesUsed, ShowAllImprovements)
    
    
        'InitialCost is the cost BEFORE any of these improvement.
        'CurrentCost is the cost of the last iteration.
        'Initial
        CurrentCost = InitialCost
    Do
            Iteration = Iteration + 1
            ResultA = False
            ResultB = False
            ResultC = False
            ResultD = False
            RandomNumber = Rnd
    
            
            If RandomNumber <= ProbA Then
                CurrentHeuristic = "A"
                Call HeuristicA_RemoveLeastPopularFrequency(Domain(), FrequencyListAndPopularities(), NumOfRequests, NumOfFrequencies, Improvement, CurrentCost, NewCost, ShowAllImprovements, ResultA, txt1, txt2, txt3)
            ElseIf RandomNumber <= (ProbB + ProbA) Then
                CurrentHeuristic = "B"
                Call HeuristicB_LowerCostMove(Domain(), NumOfRequests, NumOfFrequencies, FrequencyListAndPopularities, Improvement, CurrentCost, NewCost, ShowAllImprovements, ResultB, txt1, txt2, txt3)
            ElseIf RandomNumber <= (ProbC + ProbB + ProbA) Then
                CurrentHeuristic = "C"
                Call HeuristicC_SameCostSwap(Domain, FrequencyListAndPopularities, NumOfRequests, NumOfFrequencies, Improvement, CurrentCost, NewCost, ShowAllImprovements, ResultC, txt1, txt2, txt3)
            ElseIf RandomNumber <= 1 Then
                CurrentHeuristic = "D"
                Call HeuristicD_WorseMove(Domain, NumOfRequests, NumOfFrequencies, FrequencyListAndPopularities, Improvement, NewCost, ShowAllImprovements, ResultD, txt1, txt2, txt3)
           End If
            
          NumOfFrequenciesUsed = CountFrequenciesUsed_1D(Domain())

    
            If (ResultA = True Or ResultB = True Or ResultC = True Or ResultD = True) Then
                Improvement = Improvement + 1
                If ShowAllImprovements = True Then Call PrintImprToAssignmentANDPopsSheets(Domain, FrequencyListAndPopularities(), Improvement, NewCost, txt1, txt2, txt3, NumOfFrequencies, NumOfRequests, NumOfFrequenciesUsed, ShowAllImprovements)
                CurrentCost = NewCost
                FailedIterations = 0
                Else:
                FailedIterations = FailedIterations + 1
            End If
            Call UpdateProbANDPerformance(Improvement, CurrentHeuristic, MaxNumImprovements, ProbA, ProbB, ProbC, ProbD, ResultA, ResultB, ResultC, ResultD, StartProbA, StartProbB, StartProbC, StartProbD, APerformance, BPerformance, CPerformance, DPerformance)
            Call PrintHeuristicPerformance(ProbA, ProbB, ProbC, ProbD, ResultA, ResultB, ResultC, ResultD, APerformance, BPerformance, CPerformance, DPerformance, Iteration, Improvement, MaxNumImprovements, CurrentHeuristic, CurrentCost, NumOfFrequenciesUsed)
            
            'If the lower bound has been met...
            If (NumOfFrequenciesUsed = LowerBound) And (Improvement Mod 1000 = 0) Then
                Exit Do
            End If
             
    Loop Until (Improvement = MaxNumImprovements) Or (FailedIterations = MaxHHAttempts)
        
    If ShowAllImprovements = False Then
        Call PrintImprToAssignmentANDPopsSheets(Domain, FrequencyListAndPopularities(), Improvement, NewCost, "", "", "", NumOfFrequencies, NumOfRequests, NumOfFrequenciesUsed, ShowAllImprovements)
    End If
    NewNumFrequenciesUsed = CountFrequenciesUsed_1D(Domain())
    Call PrintToDatasetSheet(InputShtName, MaxNumImprovements, Improvement, FormulationMethod, FormulationDetails, "Hyper-Heuristic", InitialCost, CurrentCost, InitialNumFrequenciesUsed, NewNumFrequenciesUsed, HHFreqAttempts, StartProbA, StartProbB, StartProbC, StartProbD)
    ConditionalFormat
    Call CreateGraph
End Sub
Sub UpdateProbANDPerformance(ByVal Improvement As Integer, ByVal CurrentHeuristic As String, ByVal MaxNumImprovements As Long, ProbA As Single, ByRef ProbB As Single, ByRef ProbC As Single, ByRef ProbD As Single, ByVal ResultA As Boolean, ByVal ResultB As Boolean, ByVal ResultC As Boolean, ByVal ResultD As Boolean, ByVal StartProbA As Single, ByVal StartProbB As Single, ByVal StartProbC As Single, ByVal StartProbD As Single, ByRef APerformance() As Long, ByRef BPerformance() As Long, ByRef CPerformance() As Long, ByRef DPerformance() As Long)
    Dim APrcntage As Single
    Dim BPrcntage As Single
    Dim CPrcntage As Single
    Dim DCooling As Double
    Dim NewProb As Single
    
    Dim APrcntageIncAfterC As Single
    Dim BPrcntageIncAfterC As Single
    
    Dim TempProbA As Single
    Dim TempProbB As Single
    Dim TempProbC As Single
    Dim TempProbD As Single
    'ie. 0.02 means increase by 0.02 or decrease by 0.02
    APrcntage = 0.005
    BPrcntage = 0.005
    CPrcntage = 0.005
    
    DCooling = 1 / (MaxNumImprovements * 5) 'CoolingRate
    
    'After completing a same cost move- heuC, we want to increase a and b
    APrcntageIncAfterC = 0.3
    BPrcntageIncAfterC = 0.1
    
    'First we must cool heuristic D
    ProbD = ProbD * (1 - DCooling)
    TempProbC = 1 - ProbA - ProbB - ProbD
    If TempProbC < 0 Then
        TempProbB = 1 - ProbA - ProbC - ProbD
    End If
    
    'REMEMBER- A heuristic can result in 'false' if just one constraint is broken. It might be fine the next time.
    
    If CurrentHeuristic = "A" Then
        If ResultA = True Then
            'A SUCCESS
            APerformance(1) = APerformance(1) + 1
            'Increase A, decrease B
            TempProbA = ProbA * (1 + APrcntage)
            TempProbB = 1 - TempProbA - ProbC - ProbD
            If (TempProbA < 1) And (TempProbB > 0) Then
                ProbA = TempProbA
                ProbB = TempProbB
            End If
            
    
            
            
            Else
            'A FAIL
            APerformance(2) = APerformance(2) + 1
            'Increase B, decrease A
            TempProbA = ProbA * (1 - APrcntage)
            TempProbB = 1 - TempProbA - ProbC - ProbD
            If (TempProbB < 1) And (TempProbA > 0) Then 'Prevents probability<0
                ProbA = TempProbA
                ProbB = TempProbB
            End If
        End If
          
    ElseIf CurrentHeuristic = "B" Then
        If ResultB = True Then
            'B SUCESS
            BPerformance(1) = BPerformance(1) + 1
            'Increase A & B, decrease C
            TempProbA = ProbA * (1 + APrcntage)
            TempProbB = ProbB * (1 + BPrcntage)
            TempProbC = 1 - TempProbA - TempProbB - ProbD
            If (TempProbA + TempProbB < 1) And (TempProbC > 0) Then
                ProbA = TempProbA
                ProbB = TempProbB
                ProbC = TempProbC
                If ProbC < 0 Then
                ProbC = ProbC
                End If
            End If
            Else:
            BPerformance(2) = BPerformance(2) + 1
            'Increase A & B, decrease C
            TempProbA = ProbA * (1 - APrcntage)
            TempProbB = ProbB * (1 - BPrcntage)
            TempProbC = 1 - TempProbA - TempProbB - ProbD
            If (TempProbA + TempProbB > 0) And (TempProbC < 1) Then
                ProbA = TempProbA
                ProbB = TempProbB
                ProbC = TempProbC
            End If
        End If
    
    ElseIf CurrentHeuristic = "C" Then
        If ResultC = True Then
            'C SUCCESS
            CPerformance(1) = CPerformance(1) + 1
            'Increase A&B, decrease C
            TempProbA = ProbA * (1 + 1 * APrcntageIncAfterC)
            TempProbB = ProbB * (1 + 1 * BPrcntageIncAfterC)
            TempProbC = 1 - TempProbA - TempProbB - ProbD
            If (TempProbA + TempProbB < 1) And (TempProbC > 0) Then
                ProbA = TempProbA
                ProbB = TempProbB
                ProbC = TempProbC
            End If
                   
            Else
            'C FAIL
            CPerformance(2) = CPerformance(2) + 1
        End If
    
    
    ElseIf CurrentHeuristic = "D" Then
        If ResultD = True Then
            DPerformance(1) = DPerformance(1) + 1
            Else
            DPerformance(2) = DPerformance(2) + 1
        End If
    End If

End Sub

Sub PrintHeuristicPerformance(ProbA As Single, ByRef ProbB As Single, ByRef ProbC As Single, ByRef ProbD As Single, ByVal ResultA As Boolean, ByVal ResultB As Boolean, ByVal ResultC As Boolean, ByVal ResultD As Boolean, ByRef APerformance() As Long, ByRef BPerformance() As Long, ByRef CPerformance() As Long, ByRef DPerformance() As Long, ByVal Iteration As Single, ByVal Improvement As Integer, ByVal MaxNumImprovements As Long, ByVal CurrentHeuristic As String, ByVal Cost As Double, ByVal NumOfFrequenciesUsed As Integer)
    Dim EmptyColn As Integer
    Dim PrintEvery As Integer
    Dim Denominator As Long
    
    
    'Safety
    
    
    If MaxNumImprovements <= 2000 Then
        PrintEvery = 2
    ElseIf MaxNumImprovements <= 5000 Then
        PrintEvery = 10
    ElseIf MaxNumImprovements <= 10000 Then
            PrintEvery = 25
    ElseIf MaxNumImprovements <= 15000 Then
            PrintEvery = 50
    ElseIf MaxNumImprovements <= 40000 Then
            PrintEvery = 400
    End If
    
    Do
    EmptyColn = EmptyColn + 1
    Loop Until Sheets("HeuristicPerformance").Cells(4, EmptyColn) = ""
    
    If (Iteration Mod PrintEvery = 0) Or (Improvement = MaxNumImprovements) Then
        'Print All the stuff
        Sheets("HeuristicPerformance").Cells(1, EmptyColn) = Iteration
        Sheets("HeuristicPerformance").Cells(2, EmptyColn) = Improvement
        
        Sheets("HeuristicPerformance").Cells(4, EmptyColn) = ProbA
        Sheets("HeuristicPerformance").Cells(5, EmptyColn) = ProbB
        Sheets("HeuristicPerformance").Cells(6, EmptyColn) = ProbC
        Sheets("HeuristicPerformance").Cells(7, EmptyColn) = ProbD
        Sheets("HeuristicPerformance").Cells(8, EmptyColn) = Cost
        Sheets("HeuristicPerformance").Cells(9, EmptyColn) = NumOfFrequenciesUsed
        
        'To prevent overflows when divising by one, we use an if function.
        Denominator = APerformance(1) + APerformance(2)
        If Denominator > 0 Then
            Sheets("HeuristicPerformance").Cells(11, EmptyColn) = APerformance(1)
            Sheets("HeuristicPerformance").Cells(12, EmptyColn) = Denominator
            Sheets("HeuristicPerformance").Cells(13, EmptyColn) = APerformance(1) / Denominator
        End If
        
        Denominator = BPerformance(1) + BPerformance(2)
        If Denominator > 0 Then
            Sheets("HeuristicPerformance").Cells(14, EmptyColn) = BPerformance(1)
            Sheets("HeuristicPerformance").Cells(15, EmptyColn) = BPerformance(1) + BPerformance(2)
            Sheets("HeuristicPerformance").Cells(16, EmptyColn) = BPerformance(1) / Denominator
        End If
        
        Denominator = CPerformance(1) + CPerformance(2)
        If Denominator > 0 Then
            Sheets("HeuristicPerformance").Cells(17, EmptyColn) = CPerformance(1)
            Sheets("HeuristicPerformance").Cells(18, EmptyColn) = CPerformance(1) + CPerformance(2)
            Sheets("HeuristicPerformance").Cells(19, EmptyColn) = CPerformance(1) / Denominator
        End If
        
        Denominator = DPerformance(1) + DPerformance(2)
        If Denominator > 0 Then
            Sheets("HeuristicPerformance").Cells(20, EmptyColn) = DPerformance(1)
            Sheets("HeuristicPerformance").Cells(21, EmptyColn) = DPerformance(1) + DPerformance(2)
            Sheets("HeuristicPerformance").Cells(22, EmptyColn) = DPerformance(1) / Denominator
        End If
        
        If PrintEvery = 1 Then 'add extra info
            If CurrentHeuristic = "A" Then
                If ResultA = True Then
                    Sheets("HeuristicPerformance").Cells(3, EmptyColn) = "A-Success"
                Else
                    Sheets("HeuristicPerformance").Cells(3, EmptyColn) = "A-Fail"
                End If
            ElseIf CurrentHeuristic = "B" Then
                If ResultB = True Then
                    Sheets("HeuristicPerformance").Cells(3, EmptyColn) = "B-Success"
                Else
                    Sheets("HeuristicPerformance").Cells(3, EmptyColn) = "B-Fail"
                End If
            ElseIf CurrentHeuristic = "C" Then
                If ResultC = True Then
                    Sheets("HeuristicPerformance").Cells(3, EmptyColn) = "C-Success"
                Else
                    Sheets("HeuristicPerformance").Cells(3, EmptyColn) = "C-Fail"
                End If
            ElseIf CurrentHeuristic = "D" Then
                If ResultD = True Then
                    Sheets("HeuristicPerformance").Cells(3, EmptyColn) = "D-Success"
                Else
                    Sheets("HeuristicPerformance").Cells(3, EmptyColn) = "D-Fail"
                End If
            End If
        End If
    End If

End Sub
Sub PrintImprToAssignmentANDPopsSheets(ByRef Domain() As Integer, FrequencyListAndPopularities() As Integer, ByVal Improvement As Integer, ByVal CurrentCost As Double, ByVal HeuristicMethod As String, ByVal Requests As String, ByVal Frequencies As String, ByVal NumOfFrequencies As Integer, ByVal NumOfRequests As Integer, ByVal NumOfFrequenciesUsed As Integer, ByVal ShowAllImprovements As Boolean)
    'Prints to Descent AND working
    'Print on descent
    Dim i As Integer
    Dim PrintEvery As Integer
    Dim CurrentColumn As Integer
    PrintEvery = 1
    
    If (ShowAllImprovements = True) Then
        CurrentColumn = (Improvement / PrintEvery) + 3
        Else
        CurrentColumn = 4
    End If

    If CurrentColumn = 3 Then
        Sheets("Popularities").Cells(1, CurrentColumn).Value = "Initial:"
        Else:
        Sheets("Popularities").Cells(1, CurrentColumn).Value = Improvement & " imp."
    End If
           
    Sheets("Popularities").Cells(2, CurrentColumn).Value = NumOfFrequenciesUsed
    Sheets("Popularities").Cells(3, CurrentColumn).Value = CurrentCost
    Sheets("Popularities").Cells(4, CurrentColumn).Value = HeuristicMethod
    Sheets("Popularities").Cells(5, CurrentColumn).Value = Requests
    Sheets("Popularities").Cells(6, CurrentColumn).Value = Frequencies
    
 
    
    For i = 1 To NumOfFrequencies
        Sheets("Popularities").Cells(i + 7, CurrentColumn).Value = FrequencyListAndPopularities(i, 2)
    Next
    
    
    Sheets("Assignments").Cells(3, CurrentColumn - 1).Value = Improvement & " itn."
    For i = 1 To NumOfRequests
        Sheets("Assignments").Cells(i + 3, CurrentColumn - 1).Value = Domain(i)
    Next


End Sub

Sub HeuristicA_RemoveLeastPopularFrequency(ByRef Domain() As Integer, ByRef FrequencyListAndPopularities() As Integer, ByVal NumOfRequests As Integer, ByVal NumOfFrequencies As Integer, ByVal Improvement As Integer, ByVal PreviousCost As Double, ByRef NewCost As Double, ByVal ShowAllImprovements As Boolean, ByRef HeuristicOkay As Boolean, ByRef txt1 As String, ByRef txt2 As String, ByRef txt3 As String)
    'We loop until the HH gives a lower cost soln, ie. going from least popular to a more popular.
    'If soln breaks constraints, heuristicokay is false, we return to main HH base
    
    
    Dim LeastPopularFrequency As Integer
    Dim NewFrequency As Integer
    Dim OldFrequency As Integer
    Dim ChangingRequest As Integer
    
    Dim LoopCounter As Integer
    Dim txt As String
    
    'Find a request that uses the least popular frequency
    LeastPopularFrequency = ChooseLeastPopularFrequency(FrequencyListAndPopularities(), NumOfFrequencies)
    ChangingRequest = FindSpecificRequest(Domain(), LeastPopularFrequency)
    LoopCounter = 0
    
    Do
        NewFrequency = ChooseRandomFrequency
        OldFrequency = Domain(ChangingRequest)
        Domain(ChangingRequest) = NewFrequency
        
    
        'Adjust popularities
        Call IncreaseFrequencyPopularities(FrequencyListAndPopularities, NewFrequency)
        Call DecreaseFrequencyPopularities(FrequencyListAndPopularities, LeastPopularFrequency)
        
        If Cost(FrequencyListAndPopularities) < PreviousCost Then
            HeuristicOkay = True
            Else
            HeuristicOkay = False
            'Undo Changes
            Call IncreaseFrequencyPopularities(FrequencyListAndPopularities, LeastPopularFrequency)
            Call DecreaseFrequencyPopularities(FrequencyListAndPopularities, NewFrequency)
            Domain(ChangingRequest) = OldFrequency
        End If
    Loop Until HeuristicOkay = True
        
    'Check the solution is valid against constraints AND lower cost (since being lower cost implies the request doesn't now use a redundant frequency)
    If CheckAllConstraints(Domain(), ChangingRequest, "Improve") = True Then
        HeuristicOkay = True
        NewCost = Cost(FrequencyListAndPopularities)
        'String to post
        txt1 = "A"
        txt2 = Str(ChangingRequest)
        txt3 = LeastPopularFrequency & "->" & NewFrequency
    
        Else:
        HeuristicOkay = False
        'Undo Changes
        Call IncreaseFrequencyPopularities(FrequencyListAndPopularities, LeastPopularFrequency)
        Call DecreaseFrequencyPopularities(FrequencyListAndPopularities, NewFrequency)
        Domain(ChangingRequest) = OldFrequency
    End If

End Sub

'Lower Cost Move - (Random request changes frequency to more popular(lower cost) frequency). 500 tries
Sub HeuristicB_LowerCostMove(ByRef Domain() As Integer, ByVal NumOfRequests As Integer, ByVal NumOfFrequencies As Integer, ByRef FrequencyListAndPopularities() As Integer, ByVal Improvement As Integer, ByVal PreviousCost As Double, ByRef NewCost As Double, ByVal ShowAllImprovements As Boolean, ByRef HeuristicOkay As Boolean, ByRef txt1 As String, ByRef txt2 As String, ByRef txt3 As String)
    'No loops, just random request moving to lower cost frequency.
    
    'Declarations
    
    Dim OldFrequency As Integer
    Dim NewFrequency As Integer
    Dim RandomRequest As Integer
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim FreqAssignOkay As Boolean
    Dim LoopCounter As Integer
    Dim txt As String
    
    'We loop until we have performed a lower cost move. ie. random request
    '......Problem only if we have just one freq left.
    
    Do
        'Pick A Random Request
        RandomRequest = Int((Rnd() * NumOfRequests) + 1)
        
        'Pick a frequency which is different.
        Do
            NewFrequency = ChooseRandomFrequency
        Loop Until Domain(RandomRequest) <> NewFrequency
            
        ' newdomain
        OldFrequency = Domain(RandomRequest)
        Domain(RandomRequest) = NewFrequency
            
        
        'Adjust the count
        Call IncreaseFrequencyPopularities(FrequencyListAndPopularities(), NewFrequency)
        Call DecreaseFrequencyPopularities(FrequencyListAndPopularities(), OldFrequency)
        
        'Check that the Heuristic is a 'LowerCostMove'
        NewCost = Cost(FrequencyListAndPopularities())
        If NewCost < PreviousCost Then
            FreqAssignOkay = True
            Else:
            FreqAssignOkay = False
            'undo the changes too
            Call IncreaseFrequencyPopularities(FrequencyListAndPopularities(), OldFrequency)
            Call DecreaseFrequencyPopularities(FrequencyListAndPopularities(), NewFrequency)
            Domain(RandomRequest) = OldFrequency
        End If
    Loop Until FreqAssignOkay = True
    
    'Check new value with constraints
    If CheckAllConstraints(Domain(), RandomRequest, "Improve") = True Then
        HeuristicOkay = True
        'String to post
        txt1 = "B"
        txt2 = Str(RandomRequest)
        txt3 = OldFrequency & "<->" & NewFrequency
        
        Else:
        HeuristicOkay = False
        'Undo the changes
        Call IncreaseFrequencyPopularities(FrequencyListAndPopularities(), OldFrequency)
        Call DecreaseFrequencyPopularities(FrequencyListAndPopularities(), NewFrequency)
        Domain(RandomRequest) = OldFrequency
    End If

End Sub

Sub HeuristicC_SameCostSwap(ByRef Domain() As Integer, ByRef FrequencyListAndPopularities() As Integer, ByVal NumOfRequests As Integer, ByVal NumOfFrequencies As Integer, ByVal Improvement As Integer, ByVal PreviousCost As Double, ByRef NewCost As Double, ByVal ShowAllImprovements As Boolean, ByRef HeuristicOkay As Boolean, ByRef txt1 As String, ByRef txt2 As String, ByRef txt3 As String)

    'Declarations
    Dim RequestA As Integer
    Dim RequestB As Integer
    Dim FrequencyA As Integer
    Dim FrequencyB As Integer
    Dim TempDomain() As Integer
    Dim i As Integer
    Dim txt As String
    ReDim TempDomain(1 To NumOfRequests)
    
    
    'Pick the requests and their assigned frequencies
    RequestA = ChooseRandomRequest(NumOfRequests)
    FrequencyA = Domain(RequestA)
    
    RequestB = ChooseRandomRequest(NumOfRequests)
    FrequencyB = Domain(RequestB)
    
    'Make the swap
    Domain(RequestA) = FrequencyB
    Domain(RequestB) = FrequencyA
    
    
    If (CheckAllConstraints(Domain(), RequestA, "Improve") = True) And (CheckAllConstraints(Domain(), RequestB, "Improve") = True) Then
        HeuristicOkay = True
        NewCost = PreviousCost
        txt1 = "C"
        txt2 = Str(RequestA) & "&" & Str(RequestB)
        txt3 = FrequencyA & "<->" & FrequencyB
        Else:
        HeuristicOkay = False
        'Undo the swap
        Domain(RequestA) = FrequencyA
        Domain(RequestB) = FrequencyB
    End If

End Sub


Sub HeuristicD_WorseMove(ByRef Domain() As Integer, ByVal NumOfRequests As Integer, ByVal NumOfFrequencies As Integer, ByRef FrequencyListAndPopularities() As Integer, ByVal Improvement As Integer, ByRef NewCost As Double, ByVal ShowAllImprovements As Boolean, ByRef HeuristicOkay As Boolean, ByRef txt1 As String, ByRef txt2 As String, ByRef txt3 As String)
    'Declarations
    Dim OldFrequency As Integer
    Dim NewFrequency As Integer
    Dim RandomRequest As Integer
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim FreqAssignOkay As Boolean
    Dim txt As String
    
    Do
        'Pick A Random Request
        RandomRequest = Int((Rnd() * NumOfRequests) + 1)
        
        'Pick a frequency which is different.
        Do
            NewFrequency = ChooseRandomFrequency
        Loop Until Domain(RandomRequest) <> NewFrequency
        
        'Give the request the new frequency
        OldFrequency = Domain(RandomRequest)
        Domain(RandomRequest) = NewFrequency
        
        
        'Adjust the count
        Call IncreaseFrequencyPopularities(FrequencyListAndPopularities(), NewFrequency)
        Call DecreaseFrequencyPopularities(FrequencyListAndPopularities(), OldFrequency)
            
        NewCost = Cost(FrequencyListAndPopularities())
        
        If NewCost > PreviousCost Then
            HeuristicOkay = True
            Else
            HeuristicOkay = False
            'Undo the changes
            Call IncreaseFrequencyPopularities(FrequencyListAndPopularities(), OldFrequency)
            Call DecreaseFrequencyPopularities(FrequencyListAndPopularities(), NewFrequency)
            Domain(RandomRequest) = OldFrequency
        End If
    Loop Until HeuristicOkay = True
    
        
    
    
    
    'Check new value with constraints
    If CheckAllConstraints(Domain(), RandomRequest, "Improve") = True Then
        HeuristicOkay = True
    
        
        txt1 = "D"
        txt2 = Str(RandomRequest)
        txt3 = OldFrequency & "->" & NewFrequency
        Else:
        HeuristicOkay = False
        'Undo the changes
        Call IncreaseFrequencyPopularities(FrequencyListAndPopularities(), OldFrequency)
        Call DecreaseFrequencyPopularities(FrequencyListAndPopularities(), NewFrequency)
        Domain(RandomRequest) = OldFrequency
    End If

End Sub