Nella selezione a torneo, viene scelto inizialmente un certo numero di individui a caso tra la popolazione e viene "indetto un torneo", il cui vincitore è l'individuo con fitness più alta. Questa procedura viene ripetuta tante volte quante sono le soluzioni da scegliere per la riproduzione. Anche qui bisogna notare come tra i candidati scelti non sia necessariamente presente la migliore soluzione del pool genetico attuale. Inoltre, la selezione a torneo ha bisogno di un altro parametro, ossia quanti individui fare partecipare al torneo. Al variare dei due parametri principali, ad esempio n il numero dei tornei e k il numero dei partecipanti, si hanno alcune situazioni particolari:

• se n = 1 e k = numerosità della popolazione, equivale a scegliere l'individuo migliore in assoluto nella popolazione corrente;
• se n = 1 e k = 1, equivale a scegliere un individuo a caso;
• se n = numerosità della popolazione e k = n, equivale a scegliere tutta la popolazione.

Per il nostro esempio useremo solo la selezione a roulette, quindi non implementerò la selezione a torneo. Ad ogni modo, data la semplicità della routine, penso che possiate facilmente scrivere un codice adatto.

Come per la selezione a roulette, si costruisce la "striscia" di probabilità di ciascun individuo. In questo caso, però, si sceglie un numero casuale f compreso tra 0 e F / N, dove F è la fitness totale e N il numero di candidati che si vuole scegliere. A questo punto, si prendono i punti i*f sulla striscia, dove i varia da 0 a N-1 (incluso): vengono selezionati quegli individui nella cui fascia è caduto almeno uno dei punti calcolati, come mostrato nella seguente rappresentazione presa da wikipedia: Questa tecnica è meno usata e meno accettabile in termini di adeguatezza rispetto alle altre due illustrate. Inoltre, ha l'inconveniente di scegliere più volte lo stesso individuo se questo ha una fitness maggiore o uguale a f. Anche per questo non presenterò alcuna implementazione.

Molto semplice: si ordinano gli individui per fitness e se ne prende una certa frazione a partire da quelli con valori maggiori. Se invece di una frazione, si indica un numero finito, equivale alla selezione semplice, in cui si scelgono sempre i primi n migliori esemplari.

Prima di arrivare al passo successivo, vorrei cogliere l'occasione per indicare l'esistenza di funzioni di fitness non lineari. Nell'esempio che stiamo affrontando, la fitness dipende da una serie di prodotti e somme, ed è quindi una funzione polinomiale lineare omogenea in un certo numero di incognite. Ci sono casi in cui si vuole accentuare o smorzare la variazione di fitness tra individui più o meno "dotati". Ad esempio, introducendo un fattore quadratico aumentiamo di molto le fitness maggiori di 1 e al contempo "schiacciamo" quelle minori di 1: in questo caso i nostri valori sono dell'ordine delle centinaia, ma normalizzandoli si potrebbe ottenere qualcosa di simile. Allo stesso modo, è possibile introdurre espressioni esponenziali o logaritmiche. In particolare, le prime hanno la capacità di accentuare enormemente le probabilità di sopravvivenza in una selezione a roulette, trasformandola quasi in una selezione semplice.

Una volta selezionati i candidati, questi possono "riprodursi". Prima che possiate inferire alcunché di ambiguo, premetto che le soluzioni di un problema sono organismi asessuati. Per far avveniare questa operazione servono due genitori: il nuovo individuo è formato combinando i dati dei due genitori in modo "casuale". In genere, si punta a rappresentare ogni soluzione come array di dati o stringhe di caratteri, detti cromosomi (anche se il termine sarebbe un tantino impreciso), poiché è molto semplice mescolarli: basta scegliere un punto qualsiasi dell'array e formarne uno nuovo attaccando ai dati che lo precedono i dati dell'altro genitore che seguono quello stesso punto. Non è necessario, ma è utile, che i due cromosomi abbiamo la stessa dimensione. Nel nostro esempio, mescoleremo due array.

Private Function Crossover(ByVal Parent1 As Int32(), ByVal Parent2() As Int32) As Int32()
    Dim Result(9) As Int32
    Static Rnd As New Random(Date.Now.Millisecond)
    Dim Value As Int32 = Rnd.Next(1, 7)

    'Copia Value numeri dall'inizio di Parent1 in Result, partendo
    'dall'inizio di Result
    Array.ConstrainedCopy(Parent1, 0, Result, 0, Value)
    'Copia i rimanenti 10-Value numeri dal Value-esimo elemento di
    'Parent2 in Result, partendo da dopo l'ultimo elemento di Parent1
    Array.ConstrainedCopy(Parent2, Value, Result, Value, 10 - Value)

    Return Result
End Function

Anche nel scegliere i due genitori esistono vari modi. Quello che useremo noi non ha un nome particolare: semplicemente, si scelgono due individui dall'insieme dei candidati e si applica ad essi la funzione Crossover per produrre un figlio. L'alternativa è quella di usare l'elitismo, ossia uno scenario in cui ogni candidato si accoppia con un solo altro individuo, l'elite, che possiede la fitness più alta. Questo comportamento può essere sia utile che rischioso. Da una parte, avvantaggia la generazione di una soluzione effettivamente migliore; dall'altra accentua l'affermarsi di una sola soluzione su tutte le altre, la quale potrebbe anche non essere la migliore raggiungibile dall'algoritmo. Generalmente, è utile applicare l'elitismo quando la popolazione è estesa, mentre è dannoso quando è ristretta, poiché favorisce la cosiddetta stagnazione del pool genetico in poche generazioni.

E' naturale che durante l'evoluzione si verifichino degli eventi imprevisti che cambiano il codice gentico degli individui. È proprio la mutazione che favorisce l'evoluzione, poiché altrimenti non si potrebbero affermare nuove caratteristiche. La probabilità di mutazione è un altro importante parametro dell'algoritmo. Dopo il crossover c'è una certa probabilità che un esemplare venga modificato casualmente. Nel nostro caso potremmo sostituire un valore dell'array con un altro valore preso a caso.

'Notate che ByRef è superfluo, poiché gli array sono tipi
'reference e si comportano sempre come tali
Private Sub Mutate(ByRef Vector As Int32())
    Static Rnd As New Random(Date.Now.Millisecond)
    'Sceglie l'indice in cui modificare il numero
    Dim Index As Int32 = Rnd.Next(0, 10)
    Dim Numbers As New List(Of Int32)

    For I As Int32 = 1 To 20
        Numbers.Add(I)
    Next
    'Scarta i numeri già presenti
    For Each I As Int32 In Vector
        Numbers.Remove(I)
    Next
    'Ne aggiunge uno nuovo
    Vector(Index) = Numbers(Rnd.Next(0, Numbers.Count))

    Numbers = Nothing
End Sub

La mutazione poteva avvenire in molti altri modi diversi: ad esempio, invertendo l'ordine dei valori nell'array, sostituendo più numeri, applicando a tutti gli elementi una funzione di trasformazione qualsiasi (ma per cui valga f: [1,20]->[1,20]).

In ogni generazione si susseguono le seguenti fasi: calcolo della fitness di ogni invidiuo, selezione, crossover, mutazione, morte dei meno adatti. Nell'ultima fase, gli individui peggiori "muoiono", vengono rimossi dalla popolazione. Al loro posto sopraggiungono i figli dei candidati all'accoppiamento. La dimensione della popolazione rimane comunque costante. Un algoritmo genetico è costituito dal succedersi delle generazioni. L'algoritmo ha termine quando viene raggiunta una delle seguenti condizioni:

• Viene trovata la migliore soluzione ottima possibile (la soluzione esatta);
• Si raggiunge un certo numero di generazioni prefissato dal programmatore;
• Nel caso di situazioni più complesse, dove sono in gioco anche delle risorse, si raggiunge la fine quando le risorse si esauriscono;
• Viene raggiunta una soluzione ottima tale che non è possibile migliorarla ulteriormente in altre generazioni. Questa soluzione non è necessariamente la soluzione esatta al problema;
• Il programmatore è stanco di aspettare.

Ecco il codice completo:

Module Module1

    Public Class GeneticEngine
        Private _Population As List(Of Int32())
        Private _CrossoversNumber As Int32
        Private _MutationProbability As Double
        Private _CurrentBestVector As Int32()

        Public ReadOnly Property Population() As List(Of Int32())
            Get
                Return _Population
            End Get
        End Property

        Public Property CrossoversNumber() As Int32
            Get
                Return _CrossoversNumber
            End Get
            Set(ByVal value As Int32)
                _CrossoversNumber = value
            End Set
        End Property

        Public Property MutationProbability() As Double
            Get
                Return _MutationProbability
            End Get
            Set(ByVal value As Double)
                _MutationProbability = value
            End Set
        End Property
        
        Public ReadOnly Property CurrentBestVector() As Int32()
            Get
                Return _CurrentBestVector
            End Get
        End Property

        Public Sub New()
            _Population = New List(Of Int32())
        End Sub

        Public Function EvaluateFitness(ByVal Vector As Int32()) As Double
            Dim Result As Double = Vector.Sum(Function(I As Int32) ((I Mod 2) * 2 - 1) * I) + Vector(1) * Vector(2) * Vector(4) * Vector(6) / (2 * 3 * 5 * 7)
            If Vector.Distinct().Count < 10 Then
                Result = 0
            End If
            Return Result
        End Function

        Private Function SelectBoidsRoulette(ByVal Amount As Int32) As List(Of Int32())
            Dim Fitnesses = From Vector As Int32() In Me.Population _
                Select EvaluateFitness(Vector)
            Dim TotalFitness As Double = Fitnesses.Sum()
            Dim Result As New List(Of Int32())
            Dim Rnd As New Random(Date.Now.Millisecond)
            Dim Temp As Double = 0
            Dim Value As Double

            Do
                Value = Rnd.NextDouble()

                Temp = 0
                For I As Int32 = 0 To Fitnesses.Count() - 1
                    If (Value >= Temp) And (Value < Temp + Fitnesses(I) / TotalFitness) Then
                        If Not Result.Contains(Me.Population(I)) Then
                            Result.Add(Me.Population(I))
                        End If
                    End If
                    Temp += Fitnesses(I) / TotalFitness
                Next
            Loop Until Result.Count >= Amount

            Fitnesses = Nothing
            Rnd = Nothing

            Return Result
        End Function

        Private Function Crossover(ByVal Parent1 As Int32(), ByVal Parent2() As Int32) As Int32()
            Dim Result(9) As Int32
            Static Rnd As New Random(Date.Now.Millisecond)
            Dim Value As Int32 = Rnd.Next(1, 7)

            Array.ConstrainedCopy(Parent1, 0, Result, 0, Value)
            Array.ConstrainedCopy(Parent2, Value, Result, Value, 10 - Value)

            Return Result
        End Function

        Private Sub Mutate(ByRef Vector As Int32())
            Static Rnd As New Random(Date.Now.Millisecond)
            Dim Index As Int32 = Rnd.Next(0, 10)
            Dim Numbers As New List(Of Int32)

            For I As Int32 = 1 To 20
                Numbers.Add(I)
            Next
            For Each I As Int32 In Vector
                Numbers.Remove(I)
            Next
            Vector(Index) = Numbers(Rnd.Next(0, Numbers.Count))

            Numbers = Nothing
        End Sub

        Public Sub CreatePopulation(ByVal Size As Int32)
            Me.Population.Clear()

            Dim Rnd As New Random(Date.Now.Millisecond)
            Dim Numbers As New List(Of Int32)

            For I As Int32 = 1 To Size
                Dim Vector(9) As Int32

                Numbers.Clear()
                For J As Int32 = 1 To 20
                    Numbers.Add(J)
                Next
                For J As Int32 = 0 To 9
                    Vector(J) = Numbers(Rnd.Next(0, Numbers.Count))
                    Numbers.Remove(Vector(J))
                Next
                Me.Population.Add(Vector)
            Next
        End Sub

        Public Sub NextGeneration()
            'Seleziona gli individui col metodo della roulette
            Dim CrossoverSamples As List(Of Int32()) = SelectBoidsRoulette(Me.CrossoversNumber * 2)
            Dim Children As New List(Of Int32())
            Static Rnd As New Random(Date.Now.Millisecond)

            'Genera i figli
            For I As Int32 = 0 To CrossoverSamples.Count - 1 Step 2
                Children.Add(Crossover(CrossoverSamples(I), CrossoverSamples(I + 1)))
                'Aggiunge una mutazione casuale (MutationProbability è compresa tra 0 e 1)
                If Rnd.NextDouble() >= Me.MutationProbability Then
                    Mutate(Children(Children.Count - 1))
                End If
            Next

            'Seleziona i peggiori individui. Nella fattispecie, dalla collezione Population,
            'fissata per ogni individuo Vector la sua Fitness, seleziona tanti oggetti
            'contenenti come proprietà Vector e Fitness, quindi li ordina in modo
            'crescente in base alla fitness... 
            Dim WorstSamples = From Vector As Int32() In Me.Population _
                Let Fitness = EvaluateFitness(Vector) _
                Select Vector, Fitness _
                Order By Fitness Ascending

            'L'ultimo ha fitness più alta
            _CurrentBestVector = WorstSamples(WorstSamples.Count() - 1).Vector
            
            '... e ne prende i primi n, con n = CrossoversNumber.
            'Dato che i primi sono quelli con la fitness, minore, in pratica scegliamo i
            'peggiori individui della popolazione
            For Each Sample In WorstSamples.Take(Me.CrossoversNumber)
                Me.Population.Remove(Sample.Vector)
            Next

            'I morti vengono soppiantati dai figli dei candidati
            Me.Population.AddRange(Children)

            Children = Nothing
            CrossoverSamples = Nothing
            WorstSamples = Nothing
        End Sub
    End Class

    Sub Main()
        Dim Engine As New GeneticEngine
        Engine.CreatePopulation(20)
        Engine.CrossoversNumber = 3
        Engine.MutationProbability = 0.4

        For I As Int32 = 1 To 600
            Engine.NextGeneration()
            Console.Clear()
            Console.WriteLine("Generation " & I)
            For J As Int32 = 0 To Engine.CurrentBestVector.Length - 1
                Console.Write("{0:00} ", Engine.CurrentBestVector(J))
            Next
            Console.WriteLine("  >  Fitness = {0}", Engine.EvaluateFitness(Engine.CurrentBestVector))
        Next

        Console.ReadKey()
    End Sub
    
End Module

In questo caso, ci si ferma dopo 600 generazioni. Come avrete notato, la dimensione ridotta del pool genetico favorisce la stagnazione della popolazione anche in assenza di elitismo. Oltre alle mutazioni è possibile anche introdurre nella popolazione individui completamente nuovi, per mitigare l'effetto della stagnazione. Potete variare i parametri dell'algoritmo per osservare come variano i risultati. Nei test che ho fatto, ho raggiunto diverse possibili soluzioni con una fitness di 611.71, che sembra essere la massima possibile:

05 18 20 13 19 09 17 11 15 07
11 18 17 15 19 09 20 07 13 05
07 18 19 15 20 13 17 05 09 11