Automate evolutionary optimization processes with VBA in Excel

The goal of the algorithm is to minimize a simple mathematical function using an evolutionary approach, where we simulate natural selection, mutation, and crossover to optimize the solution.

In this example, we will minimize the function:

f(x)=x2−4x+4f(x) = x^2 – 4x + 4f(x)=x2−4x+4

Steps of the Genetic Algorithm:

1. Initialize the population: Create an initial set of candidate solutions (values for x).
2. Evaluate the population: Calculate the fitness of each solution by evaluating the function.
3. Selection: Select the best solutions for creating the next generation.
4. Crossover (Recombination): Combine selected solutions to create new offspring.
5. Mutation: Introduce small changes to some of the offspring to avoid premature convergence.
6. Repeat: Repeat steps 2 to 5 for a number of generations until the solution converges.

VBA Code for Genetic Optimization:

1. Define the objective function to minimize:

Function ObjectiveFunction(x As Double) As Double
    ' The function to minimize: f(x) = x^2 - 4x + 4
    ObjectiveFunction = x ^ 2 - 4 * x + 4
End Function

2. Initialize the population:

The population consists of a set of random solutions for x.

Sub InitializePopulation(ByRef population() As Double, populationSize As Integer, lowerBound As Double, upperBound As Double)
    Dim i As Integer
    Randomize
    For i = 1 To populationSize
        population(i) = lowerBound + (upperBound - lowerBound) * Rnd ' Generate random values
    Next i
End Sub

3. Evaluate the population:

We calculate the fitness (the function value) for each individual in the population.

Sub EvaluatePopulation(population() As Double, ByRef fitness() As Double, populationSize As Integer)
    Dim i As Integer
    For i = 1 To populationSize
        fitness(i) = ObjectiveFunction(population(i)) ' Calculate the function value (fitness)
    Next i
End Sub

4. Selection:

We select the best individuals from the population. In this case, we select the two with the lowest fitness (since we are minimizing the function).

Sub SelectBestIndividuals(population() As Double, fitness() As Double, ByRef parent1 As Double, ByRef parent2 As Double, populationSize As Integer)
    Dim i As Integer
    Dim minFitness As Double, secondMinFitness As Double
    Dim minIndex As Integer, secondMinIndex As Integer   
    minFitness = Application.WorksheetFunction.Min(fitness) ' Find the minimum fitness value
    secondMinFitness = Application.WorksheetFunction.Small(fitness, 2) ' Find the second best value   
    For i = 1 To populationSize
        If fitness(i) = minFitness Then
            minIndex = i
        End If
        If fitness(i) = secondMinFitness Then
            secondMinIndex = i
        End If
    Next i   
    parent1 = population(minIndex)
    parent2 = population(secondMinIndex)
End Sub

5. Crossover:

The crossover combines two parent solutions to generate an offspring.

Function Crossover(parent1 As Double, parent2 As Double) As Double
    ' Simple crossover: take the average of the parents
    Crossover = (parent1 + parent2) / 2
End Function

6. Mutation:

Mutation introduces small changes to the offspring. If a random condition is met, a small mutation is applied.

Function Mutate(child As Double, mutationRate As Double, lowerBound As Double, upperBound As Double) As Double
    If Rnd < mutationRate Then
        ' Mutation: Add a small random value to the child
        child = child + (upperBound - lowerBound) * (Rnd - 0.5)
    End If
    ' Ensure the child stays within bounds
    If child < lowerBound Then child = lowerBound
    If child > upperBound Then child = upperBound
    Mutate = child
End Function

7. Running the Genetic Algorithm:

Finally, we execute the genetic algorithm for a set number of generations and display the best solution found in each generation.

Sub RunGeneticAlgorithm()
    Dim populationSize As Integer
    Dim generations As Integer
    Dim mutationRate As Double
    Dim lowerBound As Double, upperBound As Double
    Dim population() As Double
    Dim fitness() As Double
    Dim parent1 As Double, parent2 As Double
    Dim child As Double
    Dim bestSolution As Double
    Dim i As Integer   
    ' Initialize parameters
    populationSize = 50 ' Population size
    generations = 100 ' Number of generations
    mutationRate = 0.1 ' Mutation rate
    lowerBound = -10 ' Lower bound for x
    upperBound = 10 ' Upper bound for x   
    ReDim population(1 To populationSize)
    ReDim fitness(1 To populationSize)   
    ' Initialize population
    InitializePopulation population, populationSize, lowerBound, upperBound   
    ' Loop through generations
    For i = 1 To generations
        ' Evaluate population
        EvaluatePopulation population, fitness, populationSize       
        ' Select best individuals
        SelectBestIndividuals population, fitness, parent1, parent2, populationSize       
        ' Crossover to create a child
        child = Crossover(parent1, parent2)       
        ' Mutate the child
        child = Mutate(child, mutationRate, lowerBound, upperBound)       
        ' Replace the worst individual with the child
        population(Application.WorksheetFunction.Match(Application.WorksheetFunction.Max(fitness), fitness, 0)) = child       
        ' Display the best solution found
        bestSolution = Application.WorksheetFunction.Min(fitness)
        Debug.Print "Generation " & i & ": Best solution = " & bestSolution
    Next i
End Sub

Explanation of the Code:

1. ObjectiveFunction: The function we want to minimize (in this case, f(x)=x2−4x+4f(x) = x^2 – 4x + 4f(x)=x2−4x+4).
2. InitializePopulation: Generates a random initial population of values for x.
3. EvaluatePopulation: Calculates the fitness of each individual in the population by evaluating the function.
4. SelectBestIndividuals: Selects the best individuals (those with the lowest fitness) to create the next generation.
5. Crossover: Combines the two best individuals (parents) to produce a new offspring.
6. Mutate: Introduces small changes to the offspring to maintain diversity in the population.
7. RunGeneticAlgorithm: Runs the genetic algorithm for a specified number of generations, continually optimizing the solution.

Conclusion:

This genetic algorithm can be applied to more complex optimization problems, such as multiple variables or specific problems like the traveling salesman problem. The above code provides a basic framework for evolutionary optimization in Excel using VBA. You can expand this algorithm by adjusting parameters, selecting different selection methods, or implementing more advanced crossover and mutation techniques.