mduga.bas

来自「遗传算法的vb实现」· BAS 代码 · 共 59 行

Attribute VB_Name = "MduGA"
Public MM As Integer '染色体条数
Public NN As Integer '染色体位数
Public M1 As Integer '第M1条染色体
Public MM1 As Integer '标记第M1条染色体
Public M2 As Integer '第M2条染色体
Public MM2 As Integer '标记第M2条染色体
Public N As Integer '在第N位交叉
Public A() As Integer '染色体
Public B() As Integer '适应度
Public MarkTemp As Integer '暂时标记最优
Public Mark As Integer '标记最优

Public Sub Exchange_A()
Dim i, j As Integer
Dim Temp() As Integer
ReDim Temp(NN)
For i = N To NN
Temp(i) = A(M1, i)
Next i
For i = N To NN
A(M1, i) = A(M2, i)
Next i
For i = N To NN
A(M2, i) = Temp(i)
Next i
End Sub

Public Sub Calculate_A()
Dim i, j As Integer
Dim Test0, Test1 As Integer
For i = 1 To MM
 Test0 = 0
 Test1 = 0
 For j = 1 To 5
 If A(i, j) = 0 Then
   Test0 = Test0 + 1
 End If
 Next j
 For j = 6 To NN
 If A(i, j) = 1 Then
   Test1 = Test1 + 1
 End If
 Next j
 B(i) = Test0 + Test1
Next i
End Sub

Public Sub Find_Optimum()
Dim i As Integer
Dim Optimum As Integer
For i = 1 To MM
If Optimum < B(i) Then
  Optimum = B(i)
  MarkTemp = i
End If
Next i
End Sub