一个 .NET 进化计算框架

• 下载源代码文件 - 24 Kb

那是什么？

进化计算是在计算环境中应用进化理论。它使用达尔文进化论的原理，例如自然选择、繁殖和突变，来逐步培养给定问题的更好解决方案。

一个示例进化计算框架

为了理解如何将进化原理应用于计算问题，需要一个框架来定义一组角色

1. 环境

环境定义了进化计算应用程序试图解决的问题。它负责计算个体的适应度，将问题空间含义分配给基因集的成员，并设置约束，例如基因突变的基线速率。环境还提供了额外的现实世界约束，例如控制种群规模以优化计算机硬件的使用。

2. 种群

种群代表一组潜在的解决方案。它可以从随机生成的或由预定义的个体集合播种的。

3. 个体（又名基因组）

基因组定义了种群成员拥有的基因数量及其明确位置。这些位置与环境测试的问题有关，并具有明确的含义，并且不可互换。当两个（或更多）个体繁殖时，新的基因集由从父代个体中随机选择的基因填充。也有可能（由环境控制）基因本身在此阶段可能发生突变。

5. 基因

基因保存用于计算基因集适应度以解决环境问题的个体变量的当前值。

它用于什么？

当解决问题的方式不明显，但可以测试解决方案的相对正确性时，进化计算最有用。

框架本身

以下基本框架定义了进化程序解决方案中涉及的元素

IEnvironment：定义环境

'\ --[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：定义一组潜在的解决方案

'\ --[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：定义一个问题的单个解决方案

'\ --[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：定义建议解决方案的单个属性

'\ --[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

示例：一个 Mastermind 求解器

Mastermind 是一款游戏，您必须猜测一组棋子的颜色和顺序，仅依赖于过去猜测的正确性。这个例子是一个快速而粗糙的应用程序，用于展示如何使用进化计算框架解决此类问题。

MastermindGene：IGene 实现

我们的简单游戏有八种可能的棋子颜色，这些颜色被描述为枚举类型。

'\ --[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 实现

这代表了对 mastermind 解决方案的单个“猜测”。

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 实现

这是一个繁殖的答案种群，我们正试图从中找到 mastermind 解决方案。

'\ --[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 实现

这定义了解决 mastermind 游戏的规则。

'\ --[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