威望0
积分7946
贡献0
在线时间762 小时
UID1
注册时间2021-4-14
最后登录2024-11-21
管理员
- UID
- 1
- 威望
- 0
- 积分
- 7946
- 贡献
- 0
- 注册时间
- 2021-4-14
- 最后登录
- 2024-11-21
- 在线时间
- 762 小时
|
- 不可行初始种群产生的程序源代码:
- 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)
- If m <> 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
复制代码 |
|