遗传算法中初始化种群一些重要的源码
不可行初始种群产生的程序源代码:Private Sub Command1_Click() '切换到不可行性初始种群产生的窗口
Form2.Show
Form1.Hide
End Sub
Private Sub Command2_Click() '切换到不可行性初始种群产生的窗口
Form3.Show
Form1.Hide
End Sub
Private Sub Form_Load() '设置窗口背景颜色
BackColor = QBColor(3)
End Sub
Private Sub Form_Unload(Cancel As Integer) '提示窗口
Dim v As Integer
v = MsgBox("你真的要关闭窗口？", vbYesNo)
If v = vbNo Then
Cancel = -1
End If
End Sub
Option Explicit '定义变量
Private Declare Function timeGetTime() Lib "winmm.dll" () As Long '声明时间函数
Dim k(1 To 100), Y(10), g(1 To 11) As Integer
Dim a, C, X, p, f, t, h, i, j, e, u, ii As Integer
Dim sh, m As Double
Dim n As String, S(1000), r(1000001) As String
Dim l(100, 10) As Single
Dim b, bb, D, z As Long
'参数注释：a，c ：参数；b，bb，D：时间；i，j：循环变量；n：染色体字符串；u：字符串长度；sh：熵值；m：概率；z：种群大小；S(1000)：存放生成的随机数；r(1000001)存放初始种群；k(1 to 100)：某一基因位上各基因的个数；Y(t)：各基因的个数
Private Sub Command1_Click() '返回主窗口
Form1.Show
Form2.Hide
End Sub
Private Sub Command3_Click() '初始化
Combo1.ListIndex = -1
Text2.Text = ""
Text7.Text = ""
Text8.Text = ""
For j = 1 To 100
k(j) = 0
t = 0
m = 0
sh = 0
n = ""
Next
For i = 1 To 100
k(i) = 0
Next
For j = 1 To 100
For i = 1 To 10
l(j, i) = 0
Next
Next
End Sub '利用For循环清空各个值及数组
Private Sub Command2_Click() '运行
b = timeGetTime() '调取程序开始时间
j = Combo1.ListIndex
If j = 1 Then '选择随机函数Rnd法
z = Text3.Text '给种群大小赋值
p = Val(Text9) '给约束赋值
For j = 1 To z
For i = 1 To 1000
bb = timeGetTime()()
Randomize (bb + i) '利用时间加循环次数作为控制因子对Rnd函数进行初始化
X = Int(p * Rnd)
t = X Mod 10
If Y(t) < p Then '当Y(t)大于各基因的约束时跳出If语句
Y(t) = Y(t) + 1
n = n & t
End If
u = Len(n)
If u = p * p Then '当染色体的长度达到100时跳出For循环，j=j+1
Exit For
End If
Next i
n = Replace(n, "0", "a") '将染色体中的所有字符"0"置换为"a"
r(j) = n
i = 1
n = ""
For t = 0 To 9 '将Y(t)进行清零
Y(t) = 0
Next
Next j
Open "F:\vb1\随机函数法.txt" For Output As #1 '输出初始种群
For i = 1 To z Step 1
Print #1, r(i)
Next i
Text7.Text = r(1) '将第一条染色体输出到窗口中
Close #1
D = timeGetTime() '调取程序结束时间
Text8.Text = (D - b) / 1000 & "秒" '统计程序运行时间
shang '调用子函数
Open "F:\vb1\重复.txt" For Output As #3 '输出初始种群中的重复染色体
For i = 1 To z - 1
For j = i + 1 To z
If r(i) = r(j) Then '如果两条染色体相同则输出
Print #3, r(i)
End If
Next
Next
Close #3
Else '选择混合同余法
p = Val(Text9) '给初始种群赋值
a = Text4.Text '给参数赋值
a = 4 * a + 1
C = Text5.Text
C = 2 * C + 1
z = Text3.Text
For j = 1 To z
bb = timeGetTime()
Randomize (bb + i) '利用时间加循环次数作为控制因子对Rnd函数进行初始化
X = Int(Rnd * (p * 10)) '产生0到99的随机数
S(1) = X
For i = 1 To 127
S(i + 1) = (a * S(i) + C) Mod 128 '对随机数进行运算
If S(i + 1) < 100 Then
u = S(i + 1) Mod 10
n = n & u
End If
Next i
n = n & (X Mod 10)
n = Replace(n, "0", "a") '将染色体中的字符"0"置换为"a"
r(j) = n
i = 1
n = ""
Next j
Open "F:\vb1\混合同余法.txt" For Output As #2'输出不可行初始种群
For i = 1 To z Step 1
Print #2, r(i)
Next i
Text7.Text = r(1) '将第一条染色体输出在窗口上
Close #2
D = timeGetTime() '调取程序结束时间
Text8.Text = (D - b) / 1000 & "秒" '统计程序运行时间
shang '调用子函数
Open "F:\vb1\重复.txt" For Output As #4 '输出重复的染色体
For i = 1 To z - 1
For j = i + 1 To z
If r(i) = r(j) Then '如果两条染色体相同则输出
Print #4, r(j)
End If
Next
Next
Close #4
End If
End Sub
Private Function shang() '子函数计算熵值
t = 0
For j = 1 To 100
For i = 1 To z
Select Case Mid(r(i), j, 1) '统计r(i)中第i基因位上的各基因个数
Case "1"
g(1) = g(1) + 1 '若是字符"1",则g(1)加1，统计字符的个数
Case "2"
g(2) = g(2) + 1
Case "3"
g(3) = g(3) + 1
Case "4"
g(4) = g(4) + 1
Case "5"
g(5) = g(5) + 1
Case "6"
g(6) = g(6) + 1
Case "7"
g(7) = g(7) + 1
Case "8"
g(8) = g(8) + 1
Case "9"
g(9) = g(9) + 1
Case "a"
g(10) = g(10) + 1
Case Else
g(11) = 0
End Select
Next
For i = 1 To 10 '不同基因的个数统计
If g(i) <> 0 Then
k(j) = k(j) + 1
End If
Next
For i = 1 To 10 '不同基因位上不同基因的概率统计
l(j, i) = g(i) / z
Next
For i = 1 To 10 '将g(10)清零
g(i) = 0
Next
If k(j) > t Then '统计各基因位上基因的最大值
t = k(j)
End If
Next
For j = 1 To 100 '将二维数组中的各个值赋给m
For i = 1 To k(j)
m = l(j, i)
Ifm <> 0 Then
sh = 1 / (Log(t) * 100) * Log(m) * (-m) + sh '计算熵值
End If
Next
Next
Text2.Text = sh '输出熵值
End Function
Private Sub Command4_Click() '在窗口中直接查看重复的初始种群
Shell "notepad.exe " & App.Path & "\重复", vbNormalFocus
End Sub
Private Sub Command6_Click() '在窗口中查看由混合同余法产生的初始种群
Shell "notepad.exe " & App.Path & "\混合同余法", vbNormalFocus
End Sub
Private Sub Command7_Click() '在窗口中查看由随机函数法产生的初始种群
Shell "notepad.exe " & App.Path & "\随机函数法", vbNormalFocus
End Sub
Private Sub Command8_Click() '查看每条染色体的个数
Load Form4
Form4.Show
End Sub
页:
[1]