遗传算法演示系统.frm

遗传算法,毕业设计.让我们一起共同学习探讨吧！

  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 jcl1_Click()
  Text1.Text = "12"
  Text2.Text = "90"
  Text3.Text = "0.99"
  Text4.Text = "0.001"
  Text5.Text = "100"
  Text9.Text = "2"
  Text10.Text = "4"
End Sub

Private Sub jcl2_Click()
  Text1.Text = "12"
  Text2.Text = "90"
  Text3.Text = "0.23"
  Text4.Text = "0.001"
  Text5.Text = "100"
  Text9.Text = "2"
  Text10.Text = "4"
End Sub

Private Sub jcl3_Click()
  Text1.Text = "12"
  Text2.Text = "90"
  Text3.Text = "0.85"
  Text4.Text = "0.03"
  Text5.Text = "100"
  Text9.Text = "2"
  Text10.Text = "4"
End Sub

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

Private Sub Option2_Click()
  Label9.Caption = "max="
  Picture1.Cls
  Picture1.Picture = LoadPicture(App.Path + "\as.bmp")
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 = Str$(-currentpop(i).fitness)
 End If
 If Option2.value = True Then
   MSFlexGrid1.Text = Str$(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
  'value = 0: Rt = 0: Ct = 0
 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 i
'''''''''''''''''''''''''''''''''''''''''
 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
 If Text1.Text = "" Or Text2.Text = "" Or Text3.Text = "" Or Text4.Text = "" Then
    N = MsgBox("请设置所需参数并执行编码和解码操作！", 48, "提示信息")
    Exit Sub
 End If
 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

Private Sub qtgm1_Click()
  Text1.Text = "12"
  Text2.Text = "90"
  Text3.Text = "0.45"
  Text4.Text = "0.03"
  Text5.Text = "100"
  Text9.Text = "2"
  Text10.Text = "4"
End Sub

Private Sub qtgm2_Click()
  Text1.Text = "12"
  Text2.Text = "50"
  Text3.Text = "0.45"
  Text4.Text = "0.03"
  Text5.Text = "100"
  Text9.Text = "2"
  Text10.Text = "4"
End Sub

Private Sub qtgm3_Click()
  Text1.Text = "12"
  Text2.Text = "100"
  Text3.Text = "0.45"
  Text4.Text = "0.03"
  Text5.Text = "100"
  Text9.Text = "2"
  Text10.Text = "4"
End Sub


Private Sub Text8_Change()
 baochu.Enabled = True
End Sub

Private Sub tuichu_Click()
  End
End Sub