Como exemplo, vamos imaginar a função custo como sendo a função de segundo grau

O ponto de mínimo dessa função é a soma das duas raízes 2 e 3 divididas por 2. O ponto de mínimo é 2,5 e seu valor de custo mínimo é -0,25. Será que o algoritmo genético consegue encontrar esse mínimo apenas mexendo com os dados como se fossem DNA?

Escolhendo um máximo de 100 gerações ou uma tolerância menor que 0,1 como critérios de parada, o programa encontrou como ponto mínimo 2,50034 e valor mínimo da função -0,249999. A tolerância ficou em 0,78, pois o critério de 100 gerações ocorreu primeiro, como pode ser visto na planilha a seguir.

 

 

Pode-se reparar que dois cromossomos foram gerados, separando os 10 melhores de toda população no cromossomo-1. O cromossomo-1 vai da linha 2 até a linha 11 da planilha e o cromossomo-2 vai da linha 12 até a linha 21. O fator de mutação utilizado foi de 40%.

Isso significa que um par de dados escolhido de forma aleatória sofre uma modificação de 40% de seu valor x afetando assim o resultado na função f(x). Da mesma forma o fator de cruzamento (crossing-over) foi de 70%. Isso significa que gerado um número aleatório entre 0 e 1, multiplica-se esse número por 0,7 para escolha da linha onde o primeiro gene (par de dados) sairá do cromossomo-1 e irá para o cromossomo-2.

Da mesma forma faz-se a escolha do par de dados do cromossomo-2 para o cromossomo-1. O algoritmo então reavalia todos os pares para ordenação, escolha e troca dos melhores resultados. O programa do algoritmo genético para a função de segundo grau é descrito a seguir.

PROGRAMA ALGORITMO GENÉTICO - VBA

Sub algGen()
Dim L(100, 3) As Single
Dim x(100, 3) As Single
Dim best(100, 3) As Single
Dim i As Integer
Dim j As Integer

NCros = 2
ninic = 0
nmax = 10
geracao = 1
Randomize


'===================== geração dos primeiros pares =========


     For i = 1 To nmax
         For j = 1 To 2
            best(i, j) = 1000
         Next j
     Next i
    


'==========================================================


tolerancia = 10000

Do While tolerancia > 0.1 And geracao < 100

 

'---------------------- geração inicial -----------------


      For i = 1 To nmax * NCros
          x(i, 1) = 3 * Rnd
          Cells(i + 1, 1) = x(i, 1)
          x(i, 2) = x(i, 1) ^ 2 - 5 * x(i, 1) + 6
          Cells(i + 1, 2) = x(i, 2)
      Next i


 '------------------ seleção para mutação ---------------


        r1 = Abs(Rnd)
        f1 = Fix(r1 * (nmax * NCros)) + 1


 
 '----------------- fator genético de alteração ------


        falt = 1.4
       
       x(f1, 1) = x(f1, 1) * falt
       x(f1, 2) = x(f1, 1) ^ 2 - 5 * x(f1, 1) + 6


      
 '----------------- selecao para crossing-over -------


       rcr1 = Abs(0.7 * Rnd)
       fcr1 = Fix(rcr1 * (nmax * NCros)) + 1
 
       rcr2 = Abs(0.7 * Rnd)
       fcr2 = Fix(rcr2 * (nmax * NCros)) + 1
 
        troca = x(fcr1, 1)
        x(fcr1, 1) = x(fcr2, 1)
        x(fcr2, 1) = troca
        troca = x(fcr1, 2)
        x(fcr1, 2) = x(fcr2, 2)
        x(fcr2, 2) = troca
 

         x(fcr1, 2) = x(fcr1, 1) ^ 2 - 5 * x(fcr1, 1) + 6
         x(fcr2, 2) = x(fcr2, 1) ^ 2 - 5 * x(fcr2, 1) + 6


        
'------------------------ ordenação dos melhores --------------

 

 
 For i = 1 To nmax * NCros - 1

              If x(i, 2) > x(i + 1, 2) Then
                 troca = x(i, 1)
                 x(i, 1) = x(i + 1, 1)
                 x(i + 1, 1) = troca
                
                 troca = x(i, 2)
                 x(i, 2) = x(i + 1, 2)
                 x(i + 1, 2) = troca
                 i = 0
              End If

  Next i
 


 '--------------------- comparação de todos com os nmax melhores ----


 For j = 1 To nmax
    For i = 1 To nmax
        If x(j, 2) <= best(i, 2) Then
           best(i, 1) = x(j, 1)
           best(i, 2) = x(j, 2)
           i = nmax
          End If
    Next i
 Next j
 
 tolerancia = 0


 '--------------------- calculo da tolerância de parada ------------


 For j = 1 To nmax
     tolerancia = tolerancia + best(j, 2) ^ 2
Next j

 

' ---------------------- impressão na planilha ---------------------


tolerancia = Sqr(tolerancia)
Cells(1, 4) = "geração"
Cells(2, 4) = geracao
Cells(1, 5) = "tolerância"
Cells(2, 5) = tolerancia
For i = 1 To nmax
  For j = 1 To 2
    Cells(i + 1, j) = best(i, j)
    L(i, j) = best(i, j)
    Next j
Next i
geracao = geracao + 1

Loop
 
End Sub


'+++++++++++++++++++++ FIM DO PROGRAMA++++++++++++++++++++

 

 

Voltar ao índice de Algoritmo Genético

 

Programação em VBA-Excel