form1.frm

转载自他处

MSFlexGrid1.row = 0
MSFlexGrid1.col = 3
MSFlexGrid1.ColWidth(3) = 3500
MSFlexGrid1.Text = "变量2"
MSFlexGrid1.CellAlignment = 4
MSFlexGrid1.AllowUserResizing = flexResizeBoth
MSFlexGrid1.CellFontBold = True
MSFlexGrid1.row = 0
MSFlexGrid1.col = 4
MSFlexGrid1.ColWidth(4) = 3500
MSFlexGrid1.Text = "适应度"
MSFlexGrid1.CellAlignment = 4
MSFlexGrid1.AllowUserResizing = flexResizeBoth
MSFlexGrid1.CellFontBold = True
'''''''''''''''''''''''''''''''''''''''''''''''''
MSFlexGrid2.Cols = 4
MSFlexGrid2.Rows = 2
MSFlexGrid2.row = 0
MSFlexGrid2.col = 0
MSFlexGrid2.Text = "进化代数"
MSFlexGrid2.CellAlignment = 4
MSFlexGrid2.CellFontBold = True
MSFlexGrid2.row = 0
MSFlexGrid2.col = 1
MSFlexGrid2.ColWidth(1) = 1800
MSFlexGrid2.Text = "变量1"
MSFlexGrid2.CellAlignment = 4
MSFlexGrid2.AllowUserResizing = flexResizeBoth
MSFlexGrid2.CellFontBold = True
MSFlexGrid2.row = 0
MSFlexGrid2.col = 2
MSFlexGrid2.ColWidth(2) = 1800
MSFlexGrid2.Text = "变量2"
MSFlexGrid2.CellAlignment = 4
MSFlexGrid2.AllowUserResizing = flexResizeBoth
MSFlexGrid2.CellFontBold = True
MSFlexGrid2.row = 0
MSFlexGrid2.col = 3
MSFlexGrid2.ColWidth(3) = 1800
MSFlexGrid2.Text = "适应度"
MSFlexGrid2.CellAlignment = 4
MSFlexGrid2.AllowUserResizing = flexResizeBoth
MSFlexGrid2.CellFontBold = True
End Sub

Private Sub Option1_Click()
Label9.Caption = "min="
Picture1.Cls
Picture1.Picture = LoadPicture(App.Path + "\cs.wmf")
End Sub

Private Sub Option2_Click()
Label9.Caption = "max="
Picture1.Cls
Picture1.Picture = LoadPicture(App.Path + "\as.wmf")
End Sub

Private Sub Option3_Click()        '编码
Dim bianma As String
popsize = Val(Text2.Text)
chromsize = Val(Text1.Text)
MSFlexGrid1.Rows = popsize + 1
If chromsize Mod 2 <> 0 Then
chromsize = chromsize + 1
End If
For i = 1 To popsize
For j = 1 To chromsize
currentpop(i).chrom(j) = random(2)
Next j
Next i
For i = 1 To popsize
bianma = ""
For j = 1 To chromsize
bianma = bianma & currentpop(i).chrom(j)
Next j
MSFlexGrid1.row = i
MSFlexGrid1.col = 0
MSFlexGrid1.Text = i
MSFlexGrid1.CellAlignment = flexAlignRightBottom
MSFlexGrid1.CellFontBold = True
MSFlexGrid1.CellTextStyle = flexTextRaisedLight
MSFlexGrid1.row = i
MSFlexGrid1.col = 1
MSFlexGrid1.Text = bianma
MSFlexGrid1.CellAlignment = flexAlignRightBottom
MSFlexGrid1.CellFontBold = True
MSFlexGrid1.CellTextStyle = flexTextRaisedLight
Next i
Option3.value = False
End Sub
Private Function random(num As Integer) '产生一个随机整数
Dim s As Integer
Randomize
s = Int(num * Rnd)
random = s
End Function

Private Sub Option4_Click()     '解码
Dim xiqu(40) As Integer
x1 = Val(Text9.Text)
x2 = Val(Text10.Text)
For i = 1 To popsize
currentpop(i).varible(0) = jiema(x1, x2, currentpop(i).chrom(), chromsize / 2)
For j = 1 To chromsize / 2
xiqu(j) = currentpop(i).chrom(chromsize / 2 + j)
Next j
currentpop(i).varible(1) = jiema(x1, x2, xiqu(), chromsize / 2)
currentpop(i).fitness = funct(currentpop(i).varible(0), currentpop(i).varible(1))
MSFlexGrid1.row = i
MSFlexGrid1.col = 2
MSFlexGrid1.Text = currentpop(i).varible(0)
MSFlexGrid1.CellAlignment = flexAlignRightBottom
MSFlexGrid1.CellFontBold = True
MSFlexGrid1.CellTextStyle = flexTextRaisedLight
MSFlexGrid1.row = i
MSFlexGrid1.col = 3
MSFlexGrid1.Text = currentpop(i).varible(1)
MSFlexGrid1.CellAlignment = flexAlignRightBottom
MSFlexGrid1.CellFontBold = True
MSFlexGrid1.CellTextStyle = flexTextRaisedLight
MSFlexGrid1.row = i
MSFlexGrid1.col = 4
If Option1.value = True Then
MSFlexGrid1.Text = -currentpop(i).fitness
End If
If Option2.value = True Then
MSFlexGrid1.Text = currentpop(i).fitness
End If
MSFlexGrid1.CellAlignment = flexAlignRightBottom
MSFlexGrid1.CellFontBold = True
MSFlexGrid1.CellTextStyle = flexTextRaisedLight
Next i
Option4.value = False
End Sub
Private Function jiema(a As Double, b As Double, chrom() As Integer, n As Integer)  '解码
Dim se As Double, value As Double
se = (b - a) / (2 ^ n - 1)
value = a + demical(chrom, n) * se
jiema = value
End Function
Private Function funct(x1 As Double, x2 As Double)   '计算函数值
Dim value As Double, Rt As Double, Ct As Double
If Option1.value = True Then
value = -(100 * (x2 - x1 ^ 2) ^ 2 + (1 - x1) ^ 2)
End If
If Option2.value = True Then
Rt = (Sin((x1 ^ 2 + x2 ^ 2) ^ 0.5)) ^ 2 - 0.5
Ct = (1 + 0.001 * (x1 ^ 2 + x2 ^ 2)) ^ 2
value = 0.5 - Rt / Ct
End If
funct = value
End Function
Private Function demical(chrom() As Integer, n As Integer)  '将二进制串转化为十进制值
Dim s As Double
s = 0
For i = 1 To n
s = s + chrom(i) * (2 ^ (n - i - 1))
demical = s
Next
End Function

Private Sub Option5_Click()              '交叉
Dim crossnum As Integer
Dim xiqu(40) As Integer
Dim bm As String
pc = Val(Text3.Text)
crossnum = Int(pc * popsize)
If crossnum Mod 2 <> 0 Then
crossnum = crossnum + 1
End If
For i = 1 To crossnum / 2
jcha(i).parent(0) = random(popsize)
jcha(i).parent(1) = random(popsize)
jcha(i).xsite = random(chromsize)
jion pop(jcha(i).parent(0)).chrom(), pop(jcha(i).parent(1)).chrom(), jcha(i).xsite, chromsize
Next
For i = 1 To popsize
For j = 1 To chromsize
newpop(i).chrom(j) = pop(i).chrom(j)
Next j
newpop(i).varible(0) = jiema(x1, x2, pop(i).chrom(), chromsize / 2)
For j = 1 To chromsize / 2
xiqu(j) = pop(i).chrom(chromsize / 2 + j)
Next j
newpop(i).varible(1) = jiema(x1, x2, xiqu(), chromsize / 2)
newpop(i).fitness = funct(pop(i).varible(0), pop(i).varible(1))
Next i
For i = 1 To popsize
For j = 0 To crossnum / 2
If jcha(j).parent(0) = i Or jcha(i).parent(1) = i Then
MSFlexGrid1.row = i
MSFlexGrid1.col = 0
MSFlexGrid1.Text = "×" & i
MSFlexGrid1.CellAlignment = flexAlignRightBottom
MSFlexGrid1.CellFontBold = True
MSFlexGrid1.CellTextStyle = flexTextRaisedLight
End If
Next j
bm = ""
For j = 1 To chromsize
bm = bm & newpop(i).chrom(j)
Next j
MSFlexGrid1.row = i
MSFlexGrid1.col = 1
MSFlexGrid1.Text = bm
MSFlexGrid1.CellAlignment = flexAlignRightBottom
MSFlexGrid1.CellFontBold = True
MSFlexGrid1.CellTextStyle = flexTextRaisedLight
MSFlexGrid1.row = i
MSFlexGrid1.col = 2
MSFlexGrid1.Text = newpop(i).varible(0)
MSFlexGrid1.CellAlignment = flexAlignRightBottom
MSFlexGrid1.CellFontBold = True
MSFlexGrid1.CellTextStyle = flexTextRaisedLight
MSFlexGrid1.row = i
MSFlexGrid1.col = 3
MSFlexGrid1.Text = newpop(i).varible(1)
MSFlexGrid1.CellAlignment = flexAlignRightBottom
MSFlexGrid1.CellFontBold = True
MSFlexGrid1.CellTextStyle = flexTextRaisedLight
MSFlexGrid1.row = i
MSFlexGrid1.col = 4
If Option1.value = True Then
MSFlexGrid1.Text = -newpop(i).fitness
End If
If Option2.value = True Then
MSFlexGrid1.Text = newpop(i).fitness
End If
MSFlexGrid1.CellAlignment = flexAlignRightBottom
MSFlexGrid1.CellFontBold = True
MSFlexGrid1.CellTextStyle = flexTextRaisedLight
Next i
End Sub

Private Sub Option6_Click()     '变异
Dim mutation As Integer
Dim xiqu(40) As Integer
Dim row(500) As Integer, col(500) As Integer
pm = Val(Text4.Text)
mutation = Int(popsize * pm)
For i = 1 To mutation
row(i) = random(popsize)
col(i) = random(chromsize)
Call change(newpop(row(i)).chrom(), col(i))
Next
'''''''''''''''''''''''''''''''''''''''''
For i = 1 To popsize
newpop(i).varible(0) = jiema(x1, x2, newpop(i).chrom(), chromsize / 2)
For j = 1 To chromsize / 2
xiqu(j) = pop(i).chrom(chromsize / 2 + j)
Next j
newpop(i).varible(1) = jiema(x1, x2, xiqu(), chromsize / 2)
newpop(i).fitness = funct(newpop(i).varible(0), newpop(i).varible(1))
Next i
For i = 1 To popsize
For j = 0 To mutation
If row(j) = i Then
MSFlexGrid1.row = i
MSFlexGrid1.col = 0
MSFlexGrid1.Text = "*" & i
MSFlexGrid1.CellAlignment = flexAlignRightBottom
MSFlexGrid1.CellFontBold = True
MSFlexGrid1.CellTextStyle = flexTextRaisedLight
End If
Next j
bm = ""
For j = 1 To chromsize
bm = bm & newpop(i).chrom(j)
Next j
MSFlexGrid1.row = i
MSFlexGrid1.col = 1
MSFlexGrid1.Text = bm
MSFlexGrid1.CellAlignment = flexAlignRightBottom
MSFlexGrid1.CellFontBold = True
MSFlexGrid1.CellTextStyle = flexTextRaisedLight
MSFlexGrid1.row = i
MSFlexGrid1.col = 2
MSFlexGrid1.Text = newpop(i).varible(0)
MSFlexGrid1.CellAlignment = flexAlignRightBottom
MSFlexGrid1.CellFontBold = True
MSFlexGrid1.CellTextStyle = flexTextRaisedLight
MSFlexGrid1.row = i
MSFlexGrid1.col = 3
MSFlexGrid1.Text = newpop(i).varible(1)
MSFlexGrid1.CellAlignment = flexAlignRightBottom
MSFlexGrid1.CellFontBold = True
MSFlexGrid1.CellTextStyle = flexTextRaisedLight
MSFlexGrid1.row = i
MSFlexGrid1.col = 4
If Option1.value = True Then
MSFlexGrid1.Text = -newpop(i).fitness
End If
If Option2.value = True Then
MSFlexGrid1.Text = newpop(i).fitness
End If
MSFlexGrid1.CellAlignment = flexAlignRightBottom
MSFlexGrid1.CellFontBold = True
MSFlexGrid1.CellTextStyle = flexTextRaisedLight
Next i
'''''''''''''''''''''''''''''''''''''''''
End Sub

Private Sub Option7_Click()              '选择
Dim selct(500) As Double
Dim bm As String
For i = 1 To popsize
selct(i) = currentpop(i).fitness
Next i
Call sort(selct(), popsize)
For i = 1 To popsize
pop(i).fitness = selct(i)
For j = 1 To popsize
If selct(i) = currentpop(j).fitness Then
pop(i).varible(0) = currentpop(j).varible(0)
pop(i).varible(1) = currentpop(j).varible(1)
For k = 1 To chromsize
pop(i).chrom(k) = currentpop(j).chrom(k)
Next k
End If
Next j
Next i
For i = 1 To 20
pop(popsize + 1 - i).varible(0) = pop(i).varible(0)
pop(popsize + 1 - i).varible(1) = pop(i).varible(1)
pop(popsize + 1 - i).fitness = pop(i).fitness
For k = 1 To chromsize
pop(popsize + 1 - i).chrom(k) = pop(i).chrom(k)
Next k
Next i
For i = 1 To popsize
bm = ""
For j = 1 To chromsize
bm = bm & pop(i).chrom(j)
Next j
MSFlexGrid1.row = i
MSFlexGrid1.col = 1
MSFlexGrid1.Text = bm
MSFlexGrid1.CellAlignment = flexAlignRightBottom
MSFlexGrid1.CellFontBold = True
MSFlexGrid1.CellTextStyle = flexTextRaisedLight
MSFlexGrid1.row = i
MSFlexGrid1.col = 2
MSFlexGrid1.Text = pop(i).varible(0)
MSFlexGrid1.CellAlignment = flexAlignRightBottom
MSFlexGrid1.CellFontBold = True
MSFlexGrid1.CellTextStyle = flexTextRaisedLight
MSFlexGrid1.row = i
MSFlexGrid1.col = 3
MSFlexGrid1.Text = pop(i).varible(1)
MSFlexGrid1.CellAlignment = flexAlignRightBottom
MSFlexGrid1.CellFontBold = True
MSFlexGrid1.CellTextStyle = flexTextRaisedLight
MSFlexGrid1.row = i
MSFlexGrid1.col = 4
If Option1.value = True Then
MSFlexGrid1.Text = -pop(i).fitness
End If
If Option2.value = True Then
MSFlexGrid1.Text = pop(i).fitness
End If
MSFlexGrid1.CellAlignment = flexAlignRightBottom
MSFlexGrid1.CellFontBold = True
MSFlexGrid1.CellTextStyle = flexTextRaisedLight
Next i
Option7.value = False
End Sub
Private Sub sort(a() As Double, n As Integer)  '从大到小排序
Dim t As Double
For i = 1 To n
For j = 1 To n - 1
If a(j) < a(j + 1) Then
t = a(j)
a(j) = a(j + 1)
a(j + 1) = t
End If
Next j
Next i
End Sub
Private Sub jion(a() As Integer, b() As Integer, m As Integer, n As Integer)
Dim p As Integer
Dim jiao(40) As Integer, cha(40) As Integer
p = 1
For i = m To n
jiao(p) = a(i)
cha(p) = b(i)
p = p + 1
Next
For i = 1 To p
a(m + i) = cha(i)
b(m + i) = jiao(i)
Next
End Sub
Private Sub change(a() As Integer, m As Integer)
If a(m) = 0 Then
a(m) = 1
End If
If a(m) = 1 Then
a(m) = 0
End If
End Sub
Private Sub same(a() As Integer, b() As Integer, n As Integer)
For i = 1 To n
a(i) = b(i)
Next
End Sub
Private Function renyi(a As Integer, b As Integer)
Dim s As Integer
Randomize
s = Int((b - a + 1) * Rnd + a)
renyi = s
End Function
Private Function suiji(a As Double, b As Double)
Dim s As Double
Randomize
FH: s = Rnd
If s < a Or s > b Then
GoTo FH
End If
suiji = s
End Function