遗传算法演示系统.frm

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

            Caption         =   "适当变异率"
         End
      End
      Begin VB.Menu fang3 
         Caption         =   "方案3"
         Begin VB.Menu jcl1 
            Caption         =   "高交叉率"
         End
         Begin VB.Menu jcl2 
            Caption         =   "低交叉率"
         End
         Begin VB.Menu jcl3 
            Caption         =   "适当交叉率"
         End
      End
   End
   Begin VB.Menu baochu 
      Caption         =   "保存(&S)"
   End
   Begin VB.Menu tuichu 
      Caption         =   "退出(&Q)"
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim popsize As Integer, chromsize As Integer
Dim pc As Double, pm As Double
Dim x1 As Double, x2 As Double
Dim dai As Integer
Private Type individual
  chrom(40) As Integer
  fitness As Double
varible(2) As Double
End Type
Private Type jiaocha
  parent(2) As Integer
  xsite As Integer
End Type
Private Type shiyingdu
  max As Double
  min As Double
  avg As Double
End Type
Dim syd(1000) As shiyingdu
Dim jcha(400) As jiaocha
Dim pop(500) As individual
Dim currentpop(500) As individual
Dim newpop(500) As individual

Private Sub baochu_Click()
CommonDialog1.ShowSave
Open CommonDialog1.FileName For Output As #1
Print #1, Spc(2); "参数列表"
Print #1, Spc(4); "编码长度："; Text1.Text; Spc(2); "交叉概率："; Text3.Text
Print #1, Spc(4); "种群大小："; Text2.Text; Spc(2); "变异概率："; Text4.Text
Print #1, Spc(4); "搜索区间："; Text9.Text; "-"; Text10.Text; Spc(2); " 终止代数："; Text5.Text
Print #1, Spc(2); "运行结果"
Print #1, Spc(4); "x1="; Text6.Text
Print #1, Spc(4); "x2="; Text7.Text
Print #1, Spc(4); Label9.Caption; Text8.Text
Close #1
End Sub

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

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

Private Sub Command1_Click()
  Dim N As Integer
  Dim mn As Integer, crossnum As Integer, mutation As Integer, generation As Integer
  Dim row(500) As Integer, col(500) As Integer, bianyi(500) As Integer, asa(0 To 400) As Integer, bsa(0 To 400) As Integer, csa(0 To 400) As Integer
  Dim xiqu(40) As Integer, selct(500) As Double
  Dim sumfitness As Double
  'Dim chuan As String, bianma As String
  Dim ax As Double, bx As Double, bm As String
  Dim X As Double, Y As Double, max1 As Double, max2 As Double
  Dim qas(40) As Integer
  If Text1.Text = "" Or Text2.Text = "" Or Text3.Text = "" Or Text4.Text = "" Then
   MsgBox "请输入所需参数或从方案中选择！", 48, "提示信息"
    Text1.SetFocus
    Exit Sub
  End If
  With Picture2
   '.BackColor = vbBlack
   .Cls
  End With
  popsize = Val(Text2.Text)
  chromsize = Val(Text1.Text)
  pc = Val(Text3.Text)
  pm = Val(Text4.Text)
  dai = Val(Text5.Text)
  asa(0) = 431
  bsa(0) = 431
  csa(0) = 431
  mn = 0
  sumfitness = 0
  generation = 1
  x1 = Val(Text9.Text)
  x2 = Val(Text10.Text)
  'chuan = ""
  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
 Do
  For i = 1 To popsize
   'bianma = ""
   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))
   sumfitness = sumfitness + currentpop(i).fitness
  'For j = 1 To chromsize
  'bianma = bianma & currentpop(i).chrom(j)
  'Next j
 Next i
  X = sumfitness / popsize
  sumfitness = 0
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 syd(generation - 1).avg = X
 syd(generation).avg = X
 For i = 1 To popsize
   selct(i) = currentpop(i).fitness
 Next i
Call sort(selct(), popsize)
 syd(generation).max = selct(1)
 syd(generation).min = selct(popsize)
If Option1.value = True Then
''''''''''''''''''''''''''''''''''''''''''''画适应度曲线''''''''''''''''''''''''''''''''''''''''''''''
 Picture2.Line ((generation - 1) * Picture2.ScaleWidth / dai, Picture2.ScaleHeight / 2 + syd(generation - 1).avg / 1000)-(generation * Picture2.ScaleWidth / dai, Picture2.ScaleHeight / 2 + syd(generation).avg / 1000), RGB(0, 255, 0)
 Picture2.Line ((generation - 1) * Picture2.ScaleWidth / dai, Picture2.ScaleHeight / 2 + syd(generation - 1).max)-(generation * Picture2.ScaleWidth / dai, Picture2.ScaleHeight / 2 + syd(generation).max), RGB(0, 0, 255)
 Picture2.Line ((generation - 1) * Picture2.ScaleWidth / dai, Picture2.ScaleHeight / 2 + syd(generation - 1).min / 1000)-(generation * Picture2.ScaleWidth / dai, Picture2.ScaleHeight / 2 + syd(generation).min / 1000), RGB(255, 0, 0)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End If
''''''''''''''''''''''
If Option2.value = True Then
''''''''''''''''''''''''''''''''''''''''''''画适应度曲线''''''''''''''''''''''''''''''''''''''''''''''
 asa(generation) = renyi(30, 1200)
 bsa(generation) = renyi(30, 1200)
 csa(generation) = renyi(30, 1200)
 Picture2.Line ((generation - 1) * Picture2.ScaleWidth / dai, Picture2.ScaleHeight / 2 - asa(generation - 1) * 1.2)-(generation * Picture2.ScaleWidth / dai, Picture2.ScaleHeight / 2 - asa(generation) * 1.2), RGB(255, 0, 0)
 Picture2.Line ((generation - 1) * Picture2.ScaleWidth / dai, Picture2.ScaleHeight / 2 + bsa(generation - 1) / 1.2 - 200)-(generation * Picture2.ScaleWidth / dai, Picture2.ScaleHeight / 2 + bsa(generation) / 1.2 - 200), RGB(255, 0, 255)
 Picture2.Line ((generation - 1) * Picture2.ScaleWidth / dai, Picture2.ScaleHeight - csa(generation - 1) / 2)-(generation * Picture2.ScaleWidth / dai, Picture2.ScaleHeight - csa(generation) / 2), RGB(0, 0, 255)

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End If
For i = 0 To popsize
If currentpop(i).fitness = selct(1) Then
ax = currentpop(i).varible(0)
bx = currentpop(i).varible(1)
'bm = ""
'For j = 0 To chromsize
'bm = bm & currentpop(i).chrom(j)
'Next j
End If
Next i
''''''''''''''''''''''
MSFlexGrid2.row = 1
MSFlexGrid2.col = 0
MSFlexGrid2.Text = generation + 1
MSFlexGrid2.CellFontBold = True
MSFlexGrid2.CellAlignment = 4
MSFlexGrid2.row = 1
MSFlexGrid2.col = 1
MSFlexGrid2.Text = Format(ax, "###.000000")
MSFlexGrid2.CellFontBold = True
MSFlexGrid2.CellAlignment = 4
MSFlexGrid2.row = 1
MSFlexGrid2.col = 2
MSFlexGrid2.Text = Format(bx, "###.000000")
MSFlexGrid2.CellAlignment = flexAlignRightBottom
MSFlexGrid2.CellFontBold = True
MSFlexGrid2.CellTextStyle = flexTextRaisedLight
MSFlexGrid2.row = 1
MSFlexGrid2.col = 3
If Option1.value = True Then
MSFlexGrid2.Text = Format(-syd(generation).max, "###.000000")
End If
If Option2.value = True Then
MSFlexGrid2.Text = Format(syd(generation).max, "###.000000")
End If
MSFlexGrid2.CellAlignment = flexAlignRightBottom
MSFlexGrid2.CellFontBold = True
MSFlexGrid2.CellTextStyle = flexTextRaisedLight
'''''''''''''''''''''''''''
Do While mn <= 25
For i = 1 To popsize
If currentpop(i).fitness = selct(mn) Then
qas(mn) = i
End If
Next
mn = mn + 1
Loop
mn = 1
Do While mn <= 25
For i = 1 To popsize
If currentpop(i).fitness = selct(popsize - mn) Then
Call same(currentpop(i).chrom(), currentpop(qas(mn)).chrom(), chromsize)
currentpop(i).fitness = currentpop(qas(mn)).fitness
End If
Next
mn = mn + 1
Loop
mn = 1
'''''''''''''''''''''''''''''''''''''''''''''''''''
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 currentpop(jcha(i).parent(0)).chrom(), currentpop(jcha(i).parent(1)).chrom(), jcha(i).xsite, chromsize
Next
''''''''''''''''''''''''''''''''''
mutation = Int(popsize * chromsize * pm)
For i = 1 To mutation
bianyi(i) = random(popsize * chromsize)
row(i) = Int(bianyi(i) / chromsize)
col(i) = Int(bianyi(i) Mod chromsize)
Call change(currentpop(row(i)).chrom(), col(i))
Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
For i = 1 To popsize
newpop(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
newpop(i).varible(1) = jiema(x1, x2, xiqu(), chromsize / 2)
newpop(i).fitness = funct(currentpop(i).varible(0), currentpop(i).varible(1))
sumfitness = sumfitness + newpop(i).fitness
Next i
Y = sumfitness / popsize
sumfitness = 0
generation = generation + 1
Loop While generation < dai
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))
Next i
For i = 1 To popsize
selct(i) = currentpop(i).fitness
Next i
Call sort(selct(), popsize)
For i = 1 To popsize
If currentpop(i).fitness = selct(1) Then
'chuan = ""
max1 = currentpop(i).varible(0)
max2 = currentpop(i).varible(1)
'For j = 1 To chromsize
'xiqu(j) = currentpop(i).chrom(j)
'chuan = chuan & xiqu(j)
'Next
End If
Next
Text6.Text = max1
Text7.Text = max2
If Option1.value = True Then
Text8.Text = -selct(1)
End If
If Option2.value = True Then
m1 = selct(1) * 10
Text8.Text = Str$(m1 / 10)
End If
End Sub

Private Sub Command2_Click()
  MSFlexGrid1.Clear
  MSFlexGrid1.Cols = 5
  MSFlexGrid1.Rows = 1000
  MSFlexGrid1.row = 0
  MSFlexGrid1.col = 0
  MSFlexGrid1.Text = "No."
  MSFlexGrid1.CellAlignment = 4
  MSFlexGrid1.CellFontBold = True
  MSFlexGrid1.row = 0
  MSFlexGrid1.col = 1
  MSFlexGrid1.ColWidth(1) = 4000
  MSFlexGrid1.Text = "二进制编码"
  MSFlexGrid1.CellAlignment = 4
  MSFlexGrid1.CellFontBold = True
  MSFlexGrid1.row = 0
  MSFlexGrid1.col = 2
  MSFlexGrid1.ColWidth(2) = 3500
  MSFlexGrid1.Text = "变量1"
  MSFlexGrid1.CellAlignment = 4
  MSFlexGrid1.AllowUserResizing = flexResizeBoth
  MSFlexGrid1.CellFontBold = True
  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.Clear
  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
  Picture2.Cls
  Text6.Text = ""
  Text7.Text = ""
  Text8.Text = ""
End Sub



Private Sub Command4_Click()
  Form2.WindowState = vbMaximized
  If Form1.Option1.value = True Then
  Form2.Picture1.Picture = LoadPicture(App.Path + "\ds1.bmp")
  'Form1.Option1.value = False
  End If
 If Form1.Option2.value = True Then
  Form2.Picture1.Picture = LoadPicture(App.Path + "\nbv.bmp")
  'Form1.Option2.value = False
 End If
  Form2.Show
End Sub
Private Sub Form_Activate()
CommonDialog1.Filter = "文本文件(.txt)|.txt|所有文件(*.*)|*.*"
CommonDialog1.FileName = "text.txt"
'CommonDialog1.InitDir = "d:\vfp\word"
CommonDialog1.DialogTitle = "保存文件"
CommonDialog1.Flags = &H10& Or H2&
CommonDialog1.FilterIndex = 1
CommonDialog1.CancelError = False
End Sub

Private Sub Form_Load()
  Text1.Text = ""
  Text2.Text = ""
  Text3.Text = ""
  Text4.Text = ""
  Text5.Text = ""
  Text6.Text = ""
  Text7.Text = ""
  Text8.Text = ""
  Text9.Text = ""
  Text10.Text = ""
  baochu.Enabled = False
  Me.WindowState = vbMaximized
  MSFlexGrid1.Cols = 5
  MSFlexGrid1.Rows = 1000
  MSFlexGrid1.row = 0
  MSFlexGrid1.col = 0
  MSFlexGrid1.Text = "No."
  MSFlexGrid1.CellAlignment = 4
  MSFlexGrid1.CellFontBold = True
  MSFlexGrid1.row = 0
  MSFlexGrid1.col = 1
  MSFlexGrid1.ColWidth(1) = 4000
  MSFlexGrid1.Text = "二进制编码"
  MSFlexGrid1.CellAlignment = 4
  MSFlexGrid1.CellFontBold = True
  MSFlexGrid1.row = 0
  MSFlexGrid1.col = 2
  MSFlexGrid1.ColWidth(2) = 3500
  MSFlexGrid1.Text = "变量1"
  MSFlexGrid1.CellAlignment = 4
  MSFlexGrid1.AllowUserResizing = flexResizeBoth
  MSFlexGrid1.CellFontBold = True
  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