classgapopulation.cls

遗传算法和神经网络的结合应用

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ClassGApopulation"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit


Const MaxPopulationSize = 1000

Public populationSize As Integer                  'the size of the population
Dim individuals(MaxPopulationSize) As ClassGAnet
Public generation As Long                         'the number of generations elapsed
Public best_individual As ClassGAnet              'the fittest individual
Public current_individual As ClassGAnet           'the current individual being tested
Dim MaxFitness As Single                          'the currently determined max fitness
Dim currentIndex As Integer                       'the current array index for the individual being tested
Dim bestIndex As Integer                          'the array index of the fittest individual

Public noOfInputUnits As Integer                  'the number of input units
Dim Inputs(1000) As Single
Public noOfOutputUnits As Integer                 'the number of output units
Dim Outputs(1000) As Single

Public minHiddenUnits As Integer                  'min number of hidden units
Public maxHiddenUnits As Integer                  'max number of hidden units
Public minConnections As Integer                  'min number of connections in the network
Public MaxConnections As Integer                  'max number of connections in the network
Public connectionMutations As Integer             'max number of connection mutations
Public unitMutations As Integer                   'max number of unit mutations
Public alpha As Single                            'the maximum change to weights
Public generationGap As Single                    'governs the number of individuals from the previous generation which survive into the next
Public weightSaturation As Single                 'the maximum value for weights
Dim avFitness As Single
Public MeanFitness As Single                      'average fitness of the population


Public Sub Init(popSize As Integer, no_of_inputs As Integer, no_of_outputs As Integer)
  Dim i As Integer
  Dim net As ClassGAnet
  Dim NoOfHiddens As Integer
  
  populationSize = popSize
  noOfInputUnits = no_of_inputs
  noOfOutputUnits = no_of_outputs
  generation = 0
  MaxFitness = -1
  currentIndex = 0
  minHiddenUnits = 2
  maxHiddenUnits = 10
  minConnections = 2
  MaxConnections = 20
  connectionMutations = 2
  unitMutations = 2
  generationGap = 0.5
  weightSaturation = 5
  alpha = 0.1
  avFitness = 0
  
  For i = 0 To populationSize - 1
    Set net = New ClassGAnet
    NoOfHiddens = CInt(Rnd * (maxHiddenUnits - minHiddenUnits)) + minHiddenUnits
    Call net.Init(i, noOfInputUnits, NoOfHiddens, noOfOutputUnits)
    Set individuals(i) = net
  Next
  Call FirstIndividual
End Sub



Public Sub setBestIndividual()
  Call setCurrentIndividual(bestIndex)
End Sub



Private Sub sortPopulation()
'sorts the population by fitness
  Dim swap As Boolean
  Dim i As Integer
  Dim net As ClassGAnet
  
  swap = True
  While (swap)
    swap = False
    For i = 1 To populationSize - 1
      If (individuals(i - 1).fitness < individuals(i).fitness) Then
        swap = True
        Set net = individuals(i - 1)
        Set individuals(i - 1) = individuals(i)
        Set individuals(i) = net
      End If
    Next
  Wend
End Sub



Public Sub NextGeneration()
'proceeds to the next generation
  Dim Deadmen As Integer
  Dim i As Integer
  Dim j As Integer
  Dim mutation_probability As Single

  Call sortPopulation
  
  If (generationGap < 0.5) Then
    generationGap = 0.5
  End If
  Deadmen = populationSize * (1 - generationGap)
  
  j = 0
  For i = populationSize - Deadmen To populationSize - 1
    Call individuals(i).Free
    Call individuals(j).Copy(individuals(i))
    mutation_probability = 1 - individuals(j).fitness
    Call individuals(i).Mutate(alpha, mutation_probability, minHiddenUnits, _
            maxHiddenUnits, minConnections, MaxConnections, _
            connectionMutations, unitMutations, weightSaturation)
    j = j + 1
  Next
  MeanFitness = avFitness / populationSize
  avFitness = 0
  generation = generation + 1
  MaxFitness = -1
End Sub




Public Sub FirstIndividual()
  Call setCurrentIndividual(0)
End Sub


Public Function NextIndividual() As Boolean
  If (currentIndex < populationSize - 1) Then
    Call setCurrentIndividual(currentIndex + 1)
    NextIndividual = True
    Else
    NextIndividual = False
  End If
End Function


Public Sub setCurrentIndividual(index As Integer)
'sets the current individual to be tested
  Set current_individual = individuals(index)
  currentIndex = index
End Sub


Public Sub setInput(index As Integer, value As Single)
'sets the value of an input unit for the current individual
  Inputs(index) = value
  Call current_individual.setInput(index, value)
End Sub


Public Function getOutput(index As Integer) As Single
'returns the value of an output unit for the current individual
  Outputs(index) = current_individual.getOutput(index)
  getOutput = Outputs(index)
End Function


Public Sub Update()
  Call current_individual.Update
End Sub


Public Sub setFitness(value As Single)
  current_individual.fitness = value
  If (value > MaxFitness) Then
    MaxFitness = value
    Set best_individual = current_individual
    bestIndex = currentIndex
  End If
  avFitness = avFitness + value
End Sub


Public Function getBestIndividual() As Integer
  getBestIndividual = bestIndex
End Function



Private Sub Class_Initialize()
  Randomize
End Sub



Public Sub Save(filename As String)
  Dim fileNumber As Integer
  Dim i As Integer
  
  fileNumber = FreeFile
  Open filename For Output As #fileNumber
  
  Print #fileNumber, populationSize
  Print #fileNumber, generation
  Print #fileNumber, bestIndex

  Print #fileNumber, noOfInputUnits
  Print #fileNumber, noOfOutputUnits

  Print #fileNumber, minHiddenUnits
  Print #fileNumber, maxHiddenUnits
  Print #fileNumber, minConnections
  Print #fileNumber, MaxConnections
  Print #fileNumber, connectionMutations
  Print #fileNumber, unitMutations
  Print #fileNumber, alpha
  Print #fileNumber, generationGap
  Print #fileNumber, weightSaturation
  
  For i = 0 To populationSize - 1
    Call individuals(i).Save(fileNumber)
  Next
  
  Close #fileNumber
End Sub


Public Sub Load(filename As String)
  Dim fileNumber As Integer
  Dim i As Integer
  
  'clear any previous data
  If (populationSize > 0) Then
    For i = 0 To populationSize - 1
      Call individuals(i).Free
      Set individuals(i) = Nothing
    Next
  End If
  
  fileNumber = FreeFile
  Open filename For Input As #fileNumber
  
  Input #fileNumber, populationSize
  Input #fileNumber, generation
  Input #fileNumber, bestIndex

  Input #fileNumber, noOfInputUnits
  Input #fileNumber, noOfOutputUnits

  Input #fileNumber, minHiddenUnits
  Input #fileNumber, maxHiddenUnits
  Input #fileNumber, minConnections
  Input #fileNumber, MaxConnections
  Input #fileNumber, connectionMutations
  Input #fileNumber, unitMutations
  Input #fileNumber, alpha
  Input #fileNumber, generationGap
  Input #fileNumber, weightSaturation
  
  For i = 0 To populationSize - 1
    Set individuals(i) = New ClassGAnet
    Call individuals(i).Load(fileNumber)
  Next
  
  Close #fileNumber
  
  avFitness = 0
End Sub