Click here to Skip to main content
15,884,298 members
Articles / Programming Languages / Visual Basic
Article

A .NET evolutionary computing framework

Rate me:
Please Sign up or sign in to vote.
3.92/5 (9 votes)
2 Aug 2004CPOL3 min read 40.6K   285   24   4
An evolutionary computing demonstration.

What on earth is that?

Evolutionary computing is the application of evolutionary theory within the computing environment. It uses the principles of Darwinian Evolutionary Theory such as natural selection, reproduction, and mutation, to breed progressively better solutions to a given problem.

A sample evolutionary computing framework

To understand how evolutionary principles may be applied to a computing problem, a framework is needed to define a set of roles:

1. The environment

The environment defines the problem that the evolutionary computing application is trying to solve. It is responsible for calculating the fitness of an individual, and assigning the problem space meaning to the members of the gene set, and for setting the constraints such as the baseline rate of gene mutation. Additional real-world constraints such as the control of the population size to optimize the use of the computer hardware are also supplied by the environment.

2. The population

The population represents a set of potential solutions to the problem. It can be created from a randomly generated, or seeded by a predefined set, of individuals.

3. The individual (a.k.a. The genome)

The genome defines the number of genes a member of a population has and their explicit locations. These locations have an explicit meaning in relation to the problem being tested by the environment and are not interchangeable. When two (or more) individuals reproduce, the new gene set is populated by genes selected from one of the parent individuals at random. There is also the chance (controlled by the environment) that the genes themselves may be subject to mutation at this stage.

5. The gene

The gene holds the current value for an individual variable that is used to compute the gene set's fitness to solve the environment's problem.

What is it used for?

Evolutionary computing is most useful when it is not immediately obvious how to solve a problem, but when it is possible to test the relative correctness of a solution.

The framework itself

The following bare bones framework defines the elements involved in an evolutionary programming solution:

IEnvironment: Defines the environment

VB
'\ --[IEnvironment]------------------------------
'\  The enviornment defines the problem that the 
'\ evolutionary computing application 
'\ is trying to solve. It is responsible for 
'\ calculating the fitness of an individual 
'\ and assigning the problem space meaning to 
'\ the members of the gene set and for 
'\ setting the constrainst such as the baseline 
'\ rate of gene mutation
'\ ----------------------------------------------

Public MustInherit Class IEnvironment

    Public MustOverride Function GetPopulation() As IPopulation

    Public MustOverride Function GetHealth(ByVal TestIndividual _
                                            As IGenome) As Integer

    Public MustOverride Function Breed(ByVal Parents _
                                        As IPopulation) As IGenome

    Public MustOverride ReadOnly Property MutationRate() As Single

End Class

IPopulation : Defines a population of potential solutions

VB
'\ --[IPopulation]-------------------------------
'\ The population represents a set of potential 
'\ solutions to the problem. It can be 
'\ created from a randomly generated, or seeded 
'\ by a predefined set, of individuals.
'\ ----------------------------------------------

Public MustInherit Class IPopulation
    Inherits System.Collections.CollectionBase

#Region "Public constructors"
    Public Sub New()

    End Sub

    Public Sub New(ByVal Seedgroup() As IGenome)

    End Sub
#End Region
End Class

IGenome : Defines a single solution to a problem

VB
'\ --[IGenome]-----------------------------------
'\  The genome defines the number of genes a 
'\ member of a population has and their explicit 
'\ locations. These locations have an explicit 
'\ meaning in relation to the problem being 
'\ tested by the environment and are not 
'\ interchangeable
'\ ----------------------------------------------
Public MustInherit Class IGenome

    Public MustOverride Function _
       GetGene(ByVal GeneLocation As Object) As IGene

End Class

IGene : Defines a single property of the proposed solution

VB
'\ --[IGene]-------------------------------------
'\ The gene holds the current value for an 
'\ individual variable that is used to compute 
'\ the gene set's fitness to solve the 
'\ environment's problem
'\ ----------------------------------------------
Public MustInherit Class IGene

    Public MustOverride Property Value() As Object

    Protected Overridable Function IsValueValid() As Boolean
        Return True
    End Function

End Class

Example : A Mastermind solver

Mastermind is a game whereby you have to guess the color and order of a set of pegs, relying only on the correctness of past guesses. This example is a quick and dirty application to show how you might solve such a problem using the evolutionary computing framework.

MastermindGene : The IGene implementation

Our simple game has eight possible peg colors which are described as an enumerated type.

VB
'\ --[MastermindGuessGene]-----------------------
'\ Represents the IGene implementation that is a 
'\ single guess in the game of mastermind
'\ ----------------------------------------------
Public Class MastermindGuessGene
    Inherits IGene

    Public Enum Peg_Colours
        White_Peg
        Black_Peg
        Green_Peg
        Blue_Peg
        Yellow_Peg
        Red_Peg
        Orange_Peg
        Brown_Peg
    End Enum

#Region "Private members"
    Private _PegColour As Peg_Colours
#End Region

    Public Overrides Property Value() As Object
        Get
            Return _PegColour
        End Get
        Set(ByVal Value As Object)
            If TypeOf (Value) Is Peg_Colours Then
                _PegColour = Value
            Else
                Throw New ArgumentException("Only acceptable" & _ 
                      " value is one of the defined peg colours")
            End If
        End Set
    End Property

#Region "Public constructors"
    Public Sub New()
        '\ Start with a peg colour chosen at random
        Randomize()
        _PegColour = CType(CInt(Int((7 * Rnd()))), Peg_Colours)
    End Sub

    Public Sub New(ByVal PegColour As Peg_Colours)
        _PegColour = PegColour
    End Sub
#End Region
End Class

MastermindGenome : IGenome implementation

This represents a single "guess" at the mastermind solution.

VB
Public Class MastermindGenome
    Inherits IGenome

#Region "Private members"
    Private _MastermindGenes As New MastermindGeneCollection()
    Private _NumberOfPegHoles As Integer
#End Region

    Public Overrides Function GetGene(ByVal Location As Object) As IGene
        Return _MastermindGenes.Item(CType(Location, Integer))
    End Function

#Region "Public constructors"
    Public Sub New(ByVal NumberOfPegHoles As Integer)

        If NumberOfPegHoles <= 1 Then
            Throw New ArgumentException("There must" & _ 
                  " be at least 2 peg holes", "NumberOfPegHoles")
        ElseIf NumberOfPegHoles > 10 Then
            Throw New ArgumentException("There must" & _ 
                  " be at most 10 peg holes", "NumberOfPegHoles")
        Else
            Dim nItem As Integer
            For nItem = 1 To NumberOfPegHoles
                _MastermindGenes.Add(New MastermindGuessGene())
            Next
            _NumberOfPegHoles = NumberOfPegHoles
        End If
    End Sub
#End Region

    Public ReadOnly Property Count() As Integer
        Get
            Return _MastermindGenes.Count
        End Get
    End Property

    Public ReadOnly Property NumberOfPegHoles() As Integer
        Get
            Return _NumberOfPegHoles
        End Get
    End Property

    Public Function Contains(ByVal TestColour _
      As MastermindGuessGene.Peg_Colours) As Boolean
        Dim TestGene As MastermindGuessGene
        For Each TestGene In _MastermindGenes
            If TestGene.Value = TestColour Then
                Return True
            End If
        Next
    End Function

#Region "MastermindGeneCollection"
    '\ --[MastermindGeneCollection]--------------
    '\ A strongly typed collection of mastermind 
    '\ guess genes
    '\ ------------------------------------------
    Private Class MastermindGeneCollection
        Inherits CollectionBase

        Default Public Property Item(ByVal index _
                As Integer) As MastermindGuessGene
            Get
                Return CType(List(index), MastermindGuessGene)
            End Get
            Set(ByVal Value As MastermindGuessGene)
                List(index) = Value
            End Set
        End Property

        Public Function Add(ByVal value As MastermindGuessGene) As Integer
            Return List.Add(value)
        End Function 'Add

        Public Function IndexOf(ByVal value As MastermindGuessGene) As Integer
            Return List.IndexOf(value)
        End Function 'IndexOf

        Public Sub Insert(ByVal index As Integer, _
                ByVal value As MastermindGuessGene)
            List.Insert(index, value)
        End Sub 'Insert

        Public Sub Remove(ByVal value As MastermindGuessGene)
            List.Remove(value)
        End Sub 'Remove

        Public Function Contains(ByVal value _
               As MastermindGuessGene) As Boolean
            ' If value is not of type MastermindGuessGene,
            ' this will return false.
            Return List.Contains(value)
        End Function 'Contains

        Protected Overrides Sub OnInsert(ByVal index _
                  As Integer, ByVal value As [Object])
            ' Insert additional code to be run only when inserting values.
        End Sub 'OnInsert

        Protected Overrides Sub OnRemove(ByVal index _
                  As Integer, ByVal value As [Object])
            ' Insert additional code to be run only when removing values.
        End Sub 'OnRemove

        Protected Overrides Sub OnSet(ByVal index As _
                  Integer, ByVal oldValue As [Object], _
                  ByVal newValue As [Object])
            ' Insert additional code to be run only when setting values.
        End Sub 'OnSet

        Protected Overrides Sub OnValidate(ByVal value As [Object])
            If Not value.GetType() Is _
               Type.GetType("Mastermind.MastermindGuessGene") Then
                  Throw New ArgumentException("value must" & _ 
                        " be of type MastermindGuessGene.", "value")
            End If
        End Sub 'OnValidate 

    End Class
#End Region

End Class

MastermindPopulation : IPopulation implementation

This is a breeding population of answers from which we are trying to find the mastermind solution.

VB
'\ --[MastermindGuessPopulation]-----------------
'\ Represents the IPopulation implementation 
'\ that represents a the current guess
'\ population of a game of mastermind in 
'\ progress...
'\ ----------------------------------------------
Public Class MastermindGuessPopulation
    Inherits IPopulation

#Region "Private properties"
    Private _Genomes As New MastermindGenomeCollection()
#End Region

#Region "Public constructors"
    Public Sub New(ByVal PopulationSize As Integer, _
                         ByVal NumberOfPegholes As Integer)
        Dim nItem As Integer

        If PopulationSize <= 5 Then
            Throw New ArgumentException("There must be" & _ 
                  " at least 5 mastermind genomes in the population", _ 
                  "PopulationSize")
        ElseIf PopulationSize > 1000 Then
            Throw New ArgumentException("There must be" & _ 
                  " at most 1000 mastermind genomes in the population", _ 
                  "PopulationSize")
        Else
            For nItem = 1 To PopulationSize
                _Genomes.Add(New MastermindGenome(NumberOfPegholes))
            Next
        End If
    End Sub

    Public Sub New()

    End Sub
#End Region

#Region "Public properties"
    Default Public ReadOnly Property Item(ByVal _ 
            index As Integer) As MastermindGenome
        Get
            Return _Genomes.Item(index)
        End Get
    End Property

    Public ReadOnly Property PopulationSize() As Integer
        Get
            Return _Genomes.Count
        End Get
    End Property

    Public Function AddGenome(ByVal Genome As MastermindGenome)
        _Genomes.Add(Genome)
    End Function

    Public Sub Kill(ByVal index As Integer)
        _Genomes.RemoveAt(index)
    End Sub
#End Region

#Region "MastermindGenomeCollection"
    '\ --[MastermindGeneCollection]--------------
    '\ A strongly typed collection of mastermind 
    '\ genomes
    '\ ------------------------------------------
    Private Class MastermindGenomeCollection
        Inherits CollectionBase

        Default Public Property Item(ByVal _ 
                index As Integer) As MastermindGenome
            Get
                Return CType(List(index), MastermindGenome)
            End Get
            Set(ByVal Value As MastermindGenome)
                List(index) = Value
            End Set
        End Property

        Public Function Add(ByVal value As MastermindGenome) As Integer
            Return List.Add(value)
        End Function 'Add

        Public Function IndexOf(ByVal value As MastermindGenome) As Integer
            Return List.IndexOf(value)
        End Function 'IndexOf

        Public Sub Insert(ByVal index As Integer, _ 
                   ByVal value As MastermindGenome)
            List.Insert(index, value)
        End Sub 'Insert

        Public Sub Remove(ByVal value As MastermindGenome)
            List.Remove(value)
        End Sub 'Remove

        Public Function Contains(ByVal value As MastermindGenome) As Boolean
            ' If value is not of type MastermindGuessGene,
            ' this will return false.
            Return List.Contains(value)
        End Function 'Contains

        Protected Overrides Sub OnInsert(ByVal index _ 
                  As Integer, ByVal value As [Object])
            ' Insert additional code to be run
            ' only when inserting values.
        End Sub 'OnInsert

        Protected Overrides Sub OnRemove(ByVal index _
                  As Integer, ByVal value As [Object])
            ' Insert additional code to be run only when removing values.
        End Sub 'OnRemove

        Protected Overrides Sub OnSet(ByVal index As Integer, _
                  ByVal oldValue As [Object], _
                  ByVal newValue As [Object])
            ' Insert additional code to be run only when setting values.
        End Sub 'OnSet

        Protected Overrides Sub OnValidate(ByVal value As [Object])
            If Not value.GetType() Is _
              Type.GetType("Mastermind.MastermindGenome") Then
                Throw New ArgumentException("value must" & _ 
                      " be of type MastermindGenome.", "value")
            End If
        End Sub 'OnValidate 

    End Class
#End Region

End Class

MastermindEnvironment: IEnvironment implementation

This defines the rules by which a game of mastermind can be solved.

VB
'\ --[ManstermindEnvironment]--------------------
'\ Represents the IEnvironment implementation 
'\ that represents a game
'\ of mastermind in progress...
'\ ----------------------------------------------
Public Class MastermindEnvironment
    Inherits EvolutionaryComputingFramework.IEnvironment

#Region "Private properties"
    Private _CorrectGuess As MastermindGenome
    Private _Population As MastermindGuessPopulation
    Private _MaxScore As Integer
    Private _HealthiestIndividual As MastermindGenome
#End Region

#Region "Private constants"
    Private _PointsForRightColourWrongPosition As Int32 = 5
    Private _PointsForRightColourRightPosition As Int32 = 50
#End Region

#Region "IEnvironment implementation"
    Public Overrides Function GetPopulation() As IPopulation
        If Not _Population Is Nothing Then
            Return _Population
        Else
            Throw New InvalidOperationException("The population" & _
                                         " has not been created yet")
        End If
    End Function

    Public Overrides Function GetHealth(ByVal _
                     TestIndividual As IGenome) As Integer
        If Not TestIndividual.GetType() Is _
               Type.GetType("Mastermind.MastermindGenome") Then
            Throw New ArgumentException("TestIndividual" & _
                  " must be of type MastermindGenome.", "value")
        Else
            Dim CumulativeScore As Integer
            '\ Go through each GuessGene in the test individual
            Dim NextGuessPosition As Integer
            Dim GuessIndividual As MastermindGenome
            GuessIndividual = CType(TestIndividual, MastermindGenome)
            For NextGuessPosition = 0 To GuessIndividual.Count - 1
                '\ If it is the right colour in the right place
                ' add points for that
                If GuessIndividual.GetGene(NextGuessPosition).Value _
                   = _CorrectGuess.GetGene(NextGuessPosition).Value Then
                    CumulativeScore += _PointsForRightColourRightPosition
                Else
                    '\ Otherwise if it is the right colour in the
                    ' wrong place add points for that
 If _CorrectGuess.Contains(GuessIndividual.GetGene(NextGuessPosition).Value) Then
                        CumulativeScore += _PointsForRightColourWrongPosition
                    End If
                End If
            Next NextGuessPosition
            Return CumulativeScore
        End If
    End Function

    Public Overrides Function Breed(ByVal Parents As IPopulation) As IGenome
        '\ Currently our "mastermind species" only breeds from two parents.
        '\ Future versions can have this configurable
        ' to measure the effect of increasing the parental pool.
        Dim GenomeOut As New MastermindGenome(_CorrectGuess.NumberOfPegHoles)
        '\ Make Geneome out by selecting (at random) a dominant
        ' gene from each of the two parents
        Dim ParentOne As MastermindGenome = CType(Parents, _
                           MastermindGuessPopulation).Item(0)
        Dim ParentTwo As MastermindGenome = CType(Parents, _
                           MastermindGuessPopulation).Item(1)
        Dim GeneIndex As Integer
        For GeneIndex = 0 To GenomeOut.NumberOfPegHoles - 1
            If Rnd() <= MutationRate Then
                GenomeOut.GetGene(GeneIndex).Value = _
                            New MastermindGuessGene().Value
            Else
                If Rnd() < 0.5 Then
                    GenomeOut.GetGene(GeneIndex).Value = _
                          ParentOne.GetGene(GeneIndex).Value
                Else
                    GenomeOut.GetGene(GeneIndex).Value = _
                          ParentTwo.GetGene(GeneIndex).Value
                End If
            End If
        Next
        Return GenomeOut

    End Function

    Public Overrides ReadOnly Property MutationRate() As Single
        Get
            Return 0.1
        End Get
    End Property

#End Region

#Region "Public constructors"
    Public Sub New(ByVal PopulationSize As Integer, _
               ByVal CorrectGuess As MastermindGenome)
        _CorrectGuess = CorrectGuess
        _Population = New MastermindGuessPopulation(PopulationSize, _
                                         CorrectGuess.NumberOfPegHoles)
        _MaxScore = CorrectGuess.NumberOfPegHoles _
                                   * _PointsForRightColourRightPosition
    End Sub
#End Region

#Region "Public properties"
    Public ReadOnly Property MaximumScore() As Integer
        Get
            Return _MaxScore
        End Get
    End Property

    '\ --[NextGeneration]------------------------
    '\ Evaluates the health of each individual 
    '\ in the current population, 
    '\ killing off the least healthy and 
    '\ breeding from the rest
    '\ ------------------------------------------
    Public Sub NextGeneration()

        If _Population.PopulationSize = 0 Then
            Throw New Exception("The population is extinct")
        Else
            Dim GenomeHealth As Integer
            Dim TotalHealth As Integer
            _HealthiestIndividual = Nothing
            Dim TestGenome As Integer
            For TestGenome = 0 To _Population.PopulationSize - 1
                If _HealthiestIndividual Is Nothing Then
                    _HealthiestIndividual = _Population.Item(TestGenome)
                    TotalHealth = GetHealth(_Population.Item(TestGenome))
                Else
                    GenomeHealth = GetHealth(_Population.Item(TestGenome))
                    If GenomeHealth > GetHealth(_HealthiestIndividual) Then
                        _HealthiestIndividual = _Population.Item(TestGenome)
                    End If
                    TotalHealth = TotalHealth + GenomeHealth
                End If
            Next
            Dim Averagehealth As Integer = _
                            TotalHealth / _Population.PopulationSize
            Dim MaxIndex As Integer = _Population.PopulationSize - 1
            For TestGenome = 0 To MaxIndex
                If TestGenome > MaxIndex Then
                    Exit For
                End If
                GenomeHealth = GetHealth(_Population.Item(TestGenome))
                If GenomeHealth < Averagehealth OrElse GenomeHealth = 0 Then
                    _Population.Kill(TestGenome)
                    MaxIndex = MaxIndex - 1
                End If
            Next
            For TestGenome = 0 To _Population.PopulationSize - 2 Step 2
                Dim Parents As New MastermindGuessPopulation()
                Parents.AddGenome(_Population.Item(TestGenome))
                Parents.AddGenome(_Population.Item(TestGenome + 1))
                _Population.AddGenome(Breed(Parents))
            Next
        End If

    End Sub

    Public ReadOnly Property BestGuess() As MastermindGenome
        Get
            Return _HealthiestIndividual
        End Get
    End Property
#End Region

End Class

License

This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)


Written By
Software Developer
Ireland Ireland
C# / SQL Server developer
Microsoft MVP (Azure) 2017
Microsoft MVP (Visual Basic) 2006, 2007

Comments and Discussions

 
GeneralGenetic Programming Pin
Steven Campbell4-Aug-04 16:10
Steven Campbell4-Aug-04 16:10 
GeneralRe: Genetic Programming Pin
Duncan Edwards Jones22-Sep-05 0:01
professionalDuncan Edwards Jones22-Sep-05 0:01 
GeneralImprovements Pin
Duncan Edwards Jones3-Aug-04 11:31
professionalDuncan Edwards Jones3-Aug-04 11:31 
GeneralRe: Improvements Pin
Duncan Edwards Jones13-Jan-19 23:02
professionalDuncan Edwards Jones13-Jan-19 23:02 

General General    News News    Suggestion Suggestion    Question Question    Bug Bug    Answer Answer    Joke Joke    Praise Praise    Rant Rant    Admin Admin   

Use Ctrl+Left/Right to switch messages, Ctrl+Up/Down to switch threads, Ctrl+Shift+Left/Right to switch pages.