frmsga.frm

用vb编写的一个遗传算法的程序

VERSION 5.00
Begin VB.Form FrmSGA 
   Caption         =   "基本遗传算法"
   ClientHeight    =   4380
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   7635
   LinkTopic       =   "Form1"
   ScaleHeight     =   4380
   ScaleWidth      =   7635
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox TxtChromlength 
      Height          =   375
      Left            =   5280
      TabIndex        =   5
      Text            =   "20"
      Top             =   2040
      Width           =   975
   End
   Begin VB.TextBox TxtMaxGeneration 
      Height          =   375
      Left            =   5280
      TabIndex        =   4
      Text            =   "200"
      Top             =   1560
      Width           =   975
   End
   Begin VB.TextBox TxtPm 
      Height          =   375
      Left            =   5280
      TabIndex        =   3
      Text            =   "0.001"
      Top             =   1080
      Width           =   975
   End
   Begin VB.TextBox TxtPc 
      Height          =   375
      Left            =   5280
      TabIndex        =   2
      Text            =   "0.6"
      Top             =   600
      Width           =   975
   End
   Begin VB.TextBox TxtPopSize 
      Height          =   375
      Left            =   5280
      TabIndex        =   1
      Text            =   "80"
      Top             =   120
      Width           =   975
   End
   Begin VB.CommandButton CmdEnter 
      Caption         =   "确  定"
      Height          =   375
      Left            =   6360
      TabIndex        =   0
      Top             =   120
      Width           =   1095
   End
   Begin VB.Label LblChromlength 
      Caption         =   "编码长度："
      Height          =   375
      Left            =   4080
      TabIndex        =   10
      Top             =   2040
      Width           =   1095
   End
   Begin VB.Label LblMaxGeneration 
      Caption         =   "终止代数："
      Height          =   375
      Left            =   4080
      TabIndex        =   9
      Top             =   1560
      Width           =   1095
   End
   Begin VB.Label LblPm 
      Caption         =   "变异概率："
      Height          =   375
      Left            =   4080
      TabIndex        =   8
      Top             =   1080
      Width           =   1095
   End
   Begin VB.Label LblPc 
      Caption         =   "交叉概率："
      Height          =   375
      Left            =   4080
      TabIndex        =   7
      Top             =   600
      Width           =   1095
   End
   Begin VB.Label LblPopSize 
      Caption         =   "种群大小："
      Height          =   375
      Left            =   4080
      TabIndex        =   6
      Top             =   120
      Width           =   1095
   End
End
Attribute VB_Name = "FrmSGA"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'基本遗传算法
'选择运算使用比例选择算子加最佳个体保留策略
'交叉运算使用单点随机交叉算子
'变异运算使用基本位变异算子

Private Sub CmdEnter_Click()
'初始化基本遗传算法运行参数
PopSize = TxtPopSize.Text
Pc = TxtPc.Text
Pm = TxtPm.Text
MaxGeneration = TxtMaxGeneration.Text
ChromLength = TxtChromlength.Text

Call GenerateInitialPop                 '产生初始种群
Call CalculateFitnessValue              '计算种群个体适应度
Call FindBestAndWorstIndividual         '找出最优、最差个体
Call OutputTextReport                   '输出初始种群
Do While (Generation < MaxGeneration)
    Generation = Generation + 1
    Call GenerateNextPop                '产生下一代种群
    Call CalculateFitnessValue          '计算种群个体适应度
    Call FindBestAndWorstIndividual     '找出最优、最差个体
    Call PerformEvolution               '保留最佳个体
    Call OutputTextReport
Loop
MsgBox "完成计算！", vbOKOnly + vbInformation, "提示"
Print test  '测试
End Sub