Simulated Annealing meta-heuristic for a single machine scheduling problem with 6 tasks in Visual Basic for Applications

53 views Asked by At

I wrote this code to apply the simulated annealing algorithm to a single-machine, 6-job scheduling problem. I wanted a solution that minimizes the highest tardiness value. I think something is missing, can you help?

My code in Visual Basic for Applications:

        Option Explicit
        
        Sub SimulatedAnnealingTardiness3()
        
        Dim temperature As Double
        Dim coolingRate As Double
        Dim currentSolution(1 To 6) As Integer
        Dim bestSolution(1 To 6) As Integer
        Dim currentTardiness As Double
        Dim bestTardiness As Double
        Dim newSolution(1 To 6) As Integer
        Dim newTardiness As Double
        Dim deltaTardiness As Double
        Dim i As Integer
        
        temperature = 20
        coolingRate = 0.25
        
        For i = 1 To 6
            currentSolution(i) = i
        Next i
        For i = 1 To 6
            bestSolution(i) = currentSolution(i)
        Next i
        
        Dim processingTime(1 To 6) As Integer
        processingTime(1) = 6
        processingTime(2) = 2
        processingTime(3) = 5
        processingTime(4) = 4
        processingTime(5) = 3
        processingTime(6) = 6
            
        Dim dueDate(1 To 6) As Integer
        dueDate(1) = 9
        dueDate(2) = 12
        dueDate(3) = 15
        dueDate(4) = 11
        dueDate(5) = 17
        dueDate(6) = 18
        
        Dim completionTime(1 To 6) As Integer
        Dim Tardiness(1 To 6) As Double
        Dim maxTardiness As Double
        
        completionTime(1) = processingTime(currentSolution(1))
        Tardiness(1) = Max(0, completionTime(1) - dueDate(currentSolution(1)))
        maxTardiness = Tardiness(1)
        
        For i = 2 To 6
            completionTime(i) = completionTime(i - 1) + processingTime(currentSolution(i))
            Tardiness(i) = Max(0, completionTime(i) - dueDate(currentSolution(i)))
            maxTardiness = Max(maxTardiness, Tardiness(i))
        Next i
        
        currentTardiness = maxTardiness
        bestTardiness = currentTardiness
        
        Do While temperature > 10
            Dim j As Integer
        
            For i = 1 To 6
                newSolution(i) = currentSolution(i)
            Next i
            
            i = Int(Rnd * 5) + 1
            j = Int(Rnd * 5) + 1
            
            newSolution(i) = currentSolution(j)
            newSolution(j) = currentSolution(i)
        
            completionTime(1) = processingTime(newSolution(1))
            Tardiness(1) = Max(0, completionTime(1) - dueDate(newSolution(1)))
            maxTardiness = Tardiness(1)
            
            For i = 2 To 6
                completionTime(i) = completionTime(i - 1) + processingTime(newSolution(i))
                Tardiness(i) = Max(0, completionTime(i) - dueDate(newSolution(i)))
                maxTardiness = Max(maxTardiness, Tardiness(i))
            Next i
            
            newTardiness = maxTardiness
            
            deltaTardiness = newTardiness - currentTardiness
            
            If deltaTardiness < 0 Then
                For i = 1 To 6
                    currentSolution(i) = newSolution(i)
                Next i
                currentTardiness = newTardiness
                
                If currentTardiness < bestTardiness Then
                    For i = 1 To 6
                        bestSolution(i) = currentSolution(i)
                    Next
                    bestTardiness = currentTardiness
                End If
            
            Else
                If Exp(-deltaTardiness / temperature) > WorksheetFunction.RandBetween(0, 1) Then
                    For i = 1 To 6
                    currentSolution(i) = newSolution(i)
                    Next i
                    currentTardiness = newTardiness
                End If
            End If
            
            temperature = temperature * (1 - coolingRate)
        Loop
        
        ' Print the best solution and tardiness
        'Debug.Print "Best solution: " & Join(bestSolution, ", ")
        Debug.Print "Best tardiness: " & bestTardiness
        For i = 1 To 6
            Cells(20, i) = bestSolution(i)
        Next i
        
        End Sub

I tried, but I think something is missing... This is what I have. Please, help me!!!

Basically, I wanted a solution that minimizes the highest tardiness value.

0

There are 0 answers