modgeneratenextpop.bas

用vb编写的一个遗传算法的程序

Attribute VB_Name = "ModGenerateNextPop"
'产生下一代种群
Sub GenerateNextPop()
Call SelectionOperator  '选择
Call CrossoverOperator  '交叉
Call MutationOperator   '变异
End Sub

'选择算子
Sub SelectionOperator()
Dim i As Integer, index As Integer
Dim p As Double, sum As Double
Dim cfitness() As Double '累计相对适应度
Dim newpopulation() As individual
'计算相对适应度
ReDim cfitness(PopSize)
sum = 0#
For i = 0 To PopSize - 1
    sum = sum + Population(i).fitness
Next i
For i = 0 To PopSize - 1
    cfitness(i) = Population(i).fitness / sum
Next i
'计算累计相对适应度
For i = 1 To PopSize - 1
    cfitness(i) = cfitness(i - 1) + cfitness(i)
Next i
'选择
ReDim newpopulation(PopSize)
For i = 0 To PopSize - 1
    p = Rnd
    index = 0
    Do While (p > cfitness(index))
        index = index + 1
    Loop
    newpopulation(i) = Population(index)
Next i
For i = 0 To PopSize - 1
    Population(i) = newpopulation(i)
Next i
End Sub

'交叉算子
Sub CrossoverOperator()
Dim i As Integer, j As Integer
Dim index() As Integer
Dim point As Integer, temp As Integer
Dim p As Double
Dim ch As Integer
'随机配对，即将个体随机排列，交叉的时候按顺序两个两个的取
ReDim index(PopSize)
For i = 0 To PopSize - 1
    index(i) = i
Next i
For i = 0 To PopSize - 1
    point = Int((PopSize - i) * Rnd)
    temp = index(i)
    index(i) = index(point + i)
    index(point + i) = temp
Next i
'单点随机交叉
For i = 0 To PopSize - 2 Step 2
    p = Rnd
    If p < Pc Then
        point = Int((ChromLength - 1) * Rnd) + 1
        For j = point To ChromLength - 1
            ch = Population(index(i)).chrom(j)
            Population(index(i)).chrom(j) = Population(index(i + 1)).chrom(j)
            Population(index(i + 1)).chrom(j) = ch
        Next j
    End If
Next i
End Sub

'变异算子
Sub MutationOperator()
Dim i As Integer, j As Integer
Dim p As Double
'基本位变异
For i = 0 To PopSize - 1
    For j = 0 To ChromLength - 1
        p = Rnd
        If p < Pm Then
            If Population(i).chrom(j) = 0 Then
                Population(i).chrom(j) = 1
            Else
                Population(i).chrom(j) = 0
            End If
        End If
    Next j
Next i
End Sub