GENERANDO UN ALGORITMO GENÉTICO EN VBA

Hola a todos 🙂

Espero que estéis bien! Además dadas las fechas en las que estamos, seguro que algunos de vosotros ya estaréis empezando las vacaciones!.

En el post de hoy vamos a tratar un tema que está bastante de moda, los algoritmos evolutivos y dentro de estos, los algoritmos genéticos.

Dentro de los algoritmos genéticos existen multitud de tipos de cálculo y técnicas para obtener una simulación de cruce genético, es decir de creación y combinación de cadenas de ADN tras cada generación.

Dado que esto es un proceso, lo podemos programar en VBA (al igual que en otros muchos lenguajes de programación).

En la red hay muchos ejemplos de programación, de mayor o menor complejidad, pero que en esencia realizan los mismos pasos:

• Generación del material a tratar (cromosomas).
•  Elección del % de material óptimo (cromosomas más aptos), según criterio seleccionado.
•  Cruce del los cromosomas óptimos, según criterio seleccionado.
•  Generación de nuevos cromosomas.
•  Repetición del proceso tantas veces por generaciones que se quieran establecer.

A partir de aquí, debemos utilizar las técnicas y procedimientos de programación que mejor se ajusten a nuestro proyecto.

Como sabéis, cuando realizo un post, me gusta explicarlo bien. Que todo lector con curiosidad pueda comprender y realizar los mismos ejercicios que se proponen, es la fisolofía de esta web. Por ello, trataré de ser lo más claro posible y también de utilizar funciones y procedimientos claros en el código. Esto lo comento porque muchos de los ejemplos que circulan por la red además de ser bastante complejos, el código utilizado es dificil de seguir y comprender.

Una vez realizada esta introducción, vamos a empezar con el ejercicio paso por paso.

La situación de partida propuesta es que queremos generar X número de cromosomas con una longitud determinada y que contará con números aleatorios comprendidos del 1 al 9 (he excluido el cero para no tener que estar formateando celdas con formato texto).

Nuestro archivo Excel tendrá dos pestañas, una la llamaremos MATRIZ y otra REPORT. En la hoja MATRIZ realizaremos todos los cálculos y en REPORT mostraremos detalle de los resultados.

Contaremos con cuatro módulos, aunque el módulo principar se llama INICIAL, aquí vamos a incluir el siguiente código, que incluirá llamadas a las otras tres macros. Os muestro este código y lo vamos comentando paso a paso:

Sub MODELO_ALGORITMO_GENETICO()
'Declaramos variables
Dim Min As Integer, Max As Integer, GEN As String, GENOTIPO As String
Dim COMBO As Integer
Dim i As Integer, n As Integer, b As Integer, j As Integer
'Limpiamos hoja REPORT
Sheets("REPORT").Select
Cells.Select
Selection.ClearContents
Range("A1").Select
'Limpiamos rango de cálculos en MATRIZ
Sheets("MATRIZ").Select
With Sheets("MATRIZ")
pTotal = Application.CountA(Range("A:A"))
If pTotal > 1 Then .Range("A2:E" & pTotal).Clear
'Generamos lista consecutiva de casos
.Cells(1, 1) = "Nº DE CASOS"
For i = 2 To .Cells(2, 10) + 1
.Cells(i, 1) = i - 1
Next
'Creamos individuos
pTotal = Application.CountA(Range("A:A"))
.Cells(1, 2) = "POBLACIÓN INICIAL"
For i = 2 To pTotal
Min = 1
Max = 9
GEN = vbNullString
For n = 1 To .Cells(2, 11)
COMBO = Application.WorksheetFunction.RandBetween(Min, Max)
GEN = COMBO & GEN
Next n
Cells(i, 2) = GEN
Next i
'Creamos genotipo a comparar
.Cells(1, 7) = "GENOTIPO"
GENOTIPO = vbNullString
For n = 1 To .Cells(2, 11)
COMBO = Application.WorksheetFunction.RandBetween(Min, Max)
GENOTIPO = COMBO & GENOTIPO
Next n
Cells(2, 7) = GENOTIPO
'Iniciamos bucle por cada generación
For b = 1 To .Cells(2, 8)
If b > 1 Then
For j = 2 To pTotal
.Cells(j, 2) = .Cells(j, 5)
Next j
End If
'Llamamos al resto de macros para generar la información
Call CALIFICACIONES
Call APTOS
Call N_POBLACION
'Generamos informe resumen en la hoja REPORT
For i = 2 To pTotal
With Sheets("REPORT")
.Cells(i, 1) = Worksheets(1).Cells(i, 1)
.Cells(1, b + 1) = b & "ª" & " " & "GENERACION"
.Cells(i, b + 1) = Worksheets(1).Cells(i, 5)
.Cells(1, 1) = "Nº CASOS"
End With
Next i
Next b
End With
End Sub

Cuando lo ejecutemos, lo primero que va a hacer es limpiar de contenidos la parte del cálculo de la hoja MATRIZ y la hoja REPORT.

A continuación, generamos lista ordenada de número de casos para la muestra:

'Generamos lista consecutiva de casos
With Sheets("MATRIZ")
pTotal = Application.CountA(Range("A:A"))
If pTotal > 1 Then .Range("A2:E" & pTotal).Clear
'Generamos lista consecutiva de casos
.Cells(1, 1) = "Nº DE CASOS"
For i = 2 To .Cells(2, 10) + 1
.Cells(i, 1) = i - 1
Next

En nuestra hoja Matriz crearemos un campo para determinar el rango máximo de casos (.Cells(2, 10)+1) en este ejemplo será 10:

El resultado es este:

A continuación debemos crear nuestra población de cromosomas, teniendo en cuenta que su longitud será de 10 posiciones con números aleatorios del 1 al 9:

'Creamos individuos
pTotal = Application.CountA(Range("A:A"))
.Cells(1, 2) = "POBLACIÓN INICIAL"
For i = 2 To pTotal
Min = 1
Max = 9
GEN = vbNullString
For n = 1 To .Cells(2, 11)
COMBO = Application.WorksheetFunction.RandBetween(Min, Max)
GEN = COMBO & GEN
Next n
Cells(i, 2) = GEN
Next i

Este es el resultado:

El siguiente paso, será el de crear el GENOTIPO, o gen modelo con el que vamos a comparar el resto de genes:

'Creamos genotipo a comparar
.Cells(1, 7) = "GENOTIPO"
GENOTIPO = vbNullString
For n = 1 To .Cells(2, 11)
COMBO = Application.WorksheetFunction.RandBetween(Min, Max)
GENOTIPO = COMBO & GENOTIPO
Next n
Cells(2, 7) = GENOTIPO

Y con esto ya tenemos los elementos necesarios para iniciar el cálculo:

El siguiente paso, será generar un loop que repita el proceso tantas veces como lo hayamos indicado en la celda (2,8) de la hoja MATRIZ y a través del cual generemos el resto de macros

'Iniciamos bucle por cada generación
For b = 1 To .Cells(2, 8)
If b > 1 Then
For j = 2 To pTotal
.Cells(j, 2) = .Cells(j, 5)
Next j
End If
'Llamamos al resto de macros para generar la informacion
Call CALIFICACIONES
Call APTOS
Call N_POBLACION

En la primera de las macros, vamos a otorgar puntuación a cada uno de los cromosomas, esto lo vamos a hacer, contanto las veces que un número del genotipo se repite en un cromosoma, a más repeticiones, mayor calificación y por lo tanto más apto, esta es la macro:

Sub CALIFICACIONES()
'Declaramos variables
Dim pTotal As Integer, j As Integer, GEN As Integer
Dim apto As Integer, r As Integer, i As Integer
With Sheets("MATRIZ")
pTotal = Application.CountA(.Range("A:A"))
'Contamos las veces que se repite cada número de cada cromosoma con los números del genotipo de comparación
.Cells(1, 4) = "SELECCION"
For j = 2 To pTotal
apto = 0
For r = Len(.Cells(2, 7)) To 1 Step -1
GEN = Mid(.Cells(2, 7), r, 1)
For i = Len(.Cells(j, 2)) To 1 Step -1
If Mid(.Cells(j, 2), i, 1) = GEN Then
apto = apto + 1
End If
Next i
Next r
'Mostramos resultado
.Cells(j, 3) = apto
Next j
End With
End Sub

y este es el resultado:

El siguiente paso es llamar a la macro APTOS que se encuentra en el módulo FITNESS, para seleccionar el % de mejores genes que hemos indicado en la hoja MATRIZ, ordenando de forma descendente y seleccionando los «n» primeros casos.

Sub APTOS()
'Declaramos variables
Dim apto As Integer, pTotal As Integer
Dim j As Integer, rRango As Range, cCell As Variant
'Ordenamos la columna C descendente
With Sheets("MATRIZ")
pTotal = Application.CountA(Range("A:A"))
If pTotal > 1 Then .Range("D2:D" & pTotal).Clear
'elegimos a los n más aptos según % de seleccion
apto = Int((pTotal - 1) * .Cells(2, 9))
.Cells(1, 3) = "FITNESS"
Set rRango = Range("A1:E" & pTotal)
cCell = Range("C1")
rRango.Sort Key1:=cCell, Order1:=xlDescending, Header:=xlYes
For j = 2 To pTotal
If j - 1 <= apto Then
.Cells(j, 4) = .Cells(j, 2)
End If
Next j
'Volvemos a ordenar por la columna A
cCell = Range("A1")
rRango.Sort Key1:=cCell, Order1:=xlAscending, Header:=xlYes
End With
End Sub

Y el resultado es este:

Finalmente, debemos generar una nueva población a partir de esos genes que hemos seleccionado. En este punto, hay muchas variantes y teorías de cómo hacerlo, en este caso, yo he elegido hacerlo de una forma particular aunque siempre podréis adaptarlo a vuestras necesidades o preferencias. Lo que se realiza en este paso es lo siguiente:

Los «n» casos aptos seleccionados los paso a una variable string (todos los cromosomas en una misma linea de datos), luego creo nuevos cromosomas a partir de esa cadena de forma aleatoria, menos el número final del nuevo cromosoma, es decir el número 10 lo vuelvo a elegir de otro subproceso aleatorio de números entre 1 y 9.

Este último paso nos va a ayudar a «regular» la diversidad genética, dado que podemos elegir que se generen números del 1 al 9 pero restringiendo el rango, por ejemplo, entre 1 y 2 o entre 1 y 3 etc … A mayor rango, mayor diversidad y esto permitirá que con cada generación existan más individuos diferentes entre si, esto se regula en NIVEL DE MUTACIÓN de hoja MATRIZ. La macro completa es esta:

Sub N_POBLACION()
'Declaramos variables
Dim scadena As String, x As String
Dim i As Integer, d As Integer, punto As Integer, nGen As Integer
Dim j As Integer, n As Integer, pTotal As Integer
'Seleccionamos los cromosomas más aptos
With Sheets("MATRIZ")
pTotal = Application.CountA(.Range("A:A"))
scadena = vbNullString
.Cells(1, 5) = "NUEVA POBLACIÓN"
'Y los pasamos a una cadena
For j = 2 To pTotal
scadena = scadena & .Cells(j, 4)
Next j
'Utilizamos cada número de la cadena
'para crear una cromosoma nuevo aleatoriamente
For i = 2 To pTotal
x = vbNullString
For n = 1 To Len(scadena)
punto = Application.WorksheetFunction.RandBetween(1, Len(scadena))
nGen = Application.WorksheetFunction.RandBetween(1, .Cells(2, 12))
d = Mid(scadena, punto, 1)
x = x & d
' Generamos un nuevo cromosoma con n-1 caracteres
' y el último lo volvemos a asignar aleatoriamente (nGen)
Q = .Cells(2, 11).Value
If Len(x) = Q - 1 Then Exit For
Next n
.Cells(i, 5) = x & nGen
Next i
End With
End Sub

Y este es el resultado:

Dado que vamos a generar multitud de generaciones en cada cálculo, nos vendrá bien, pasar la información de cada cálculo a la hoja REPORT.Esto lo vamos a conseguir con esta macro situada al final de la macro INICIAL:

'Generamos informe resumen en la hoja REPORT
For i = 2 To pTotal
With Sheets("REPORT")
.Cells(i, 1) = Worksheets(1).Cells(i, 1)
.Cells(1, b + 1) = b & "ª" & " " & "GENERACION"
.Cells(i, b + 1) = Worksheets(1).Cells(i, 5)
.Cells(1, 1) = "Nº CASOS"
End With
Next i

De forma que tengamos un resumen de cada ejecución del programa con todas las generaciones que se han indicado. Y esta es la información resumen:

En el resumen podemos apreciar la evolución de la primera generación hasta la quinta, en este ejemplo, aunque tenemos un nivel de mutación de 9, el % de selección es de 20% y por eso ya en la quinta generación todos los genes son muy parecidos. La clave está en jugar con el % de seleccionados para combinar y el nivel de mutación, cuando más altos más diversidad genética.

Como habéis podido observar, es un post bastante largo y con mucho contenido, útil para analizar el proceso y las técnicas utilizadas, y siempre teniendo en cuenta que esto es un ejemplo sencillo.

Para finalizar, me gustaría comentar sobre los controles de la hoja MATRIZ, aquellas celdas que están en azul son celdas en las que se muestra el cálculo, las celdas en gris son para que indiquéis los datos con los que queréis calcular:

• GENERACIONES: Son el número de veces que vamos a generar la aplicación. y que corresponden a las generaciones evolutivas de la población inicial.
• SELECCIÓN: Es el % sobre el total que vamos a seleccionar los más aptos.
• NÚMERO DE CASOS: Es el rango de casos, grabados de forma consecutiva, 1, 2 ,3 etc.
• LONGITUD GENÉTICA: El largo o cantidad de números de cada cromosoma.
• NIVEL MUTACIÓN: Introduce en el cálculo mayor o menor rango de números comprendidos entre 1 y 9. A mayor número mayor diversidad.

Y esto ha sido todo! ha sido un ejercicio completo y muy interesante!

Espero que os haya gustado y os pueda ser de utilidad 🙂

Descarga el archivo de ejemplo pulsando en: GENERANDO UN ALGORITMO GENÉTICO EN VBA

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.



¡¡Muchas gracias!!