form1.frm

转载自他处

         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   9840
      TabIndex        =   3
      Top             =   840
      Width           =   1095
   End
   Begin VB.OptionButton Option1 
      Caption         =   "rosenbrock"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   13800
      TabIndex        =   2
      Top             =   840
      Width           =   1215
   End
   Begin VB.PictureBox Picture1 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   1095
      Left            =   9240
      ScaleHeight     =   1065
      ScaleWidth      =   5865
      TabIndex        =   0
      Top             =   1200
      Width           =   5895
   End
   Begin VB.Label Label1 
      Caption         =   "遗传算法（genetic algorithms）"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   21.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   615
      Left            =   4320
      TabIndex        =   1
      Top             =   120
      Width           =   6975
   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 Command1_Click()
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
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
Text8.Text = selct(1)
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 Command3_Click()
End
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_Load()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
Text10.Text = ""
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