⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmga.frm

📁 改进遗传算法程序
💻 FRM
字号:
VERSION 5.00
Begin VB.Form frmGA 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Genetic Algorithm Test"
   ClientHeight    =   5640
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4005
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5640
   ScaleWidth      =   4005
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Begin VB.Frame Frame2 
      Caption         =   "Best of the Family Tree"
      Height          =   2670
      Left            =   1980
      TabIndex        =   16
      ToolTipText     =   "Best of the Family Tree Bloob"
      Top             =   2520
      Width           =   1995
      Begin VB.Label lblBBC3 
         AutoSize        =   -1  'True
         Caption         =   "-----"
         Height          =   195
         Left            =   315
         TabIndex        =   39
         Top             =   2430
         Width           =   225
      End
      Begin VB.Label lblBBC2 
         AutoSize        =   -1  'True
         Caption         =   "-----"
         Height          =   195
         Left            =   315
         TabIndex        =   38
         Top             =   2025
         Width           =   225
      End
      Begin VB.Label lblBBC1 
         AutoSize        =   -1  'True
         Caption         =   "-----"
         Height          =   195
         Left            =   315
         TabIndex        =   37
         Top             =   1665
         Width           =   225
      End
      Begin VB.Label lblBBFit 
         AutoSize        =   -1  'True
         Caption         =   "-----"
         Height          =   195
         Left            =   315
         TabIndex        =   36
         Top             =   1260
         Width           =   225
      End
      Begin VB.Label lblBBGen 
         AutoSize        =   -1  'True
         Caption         =   "-----"
         Height          =   195
         Left            =   315
         TabIndex        =   35
         Top             =   810
         Width           =   225
      End
      Begin VB.Label lblBBVal 
         AutoSize        =   -1  'True
         Caption         =   "-----"
         Height          =   195
         Left            =   315
         TabIndex        =   34
         Top             =   405
         Width           =   225
      End
      Begin VB.Label Label2 
         Caption         =   "Generation Number:"
         Height          =   195
         Index           =   10
         Left            =   90
         TabIndex        =   27
         Top             =   630
         Width           =   1770
      End
      Begin VB.Label Label2 
         Caption         =   "Chromosome 3:"
         Height          =   195
         Index           =   9
         Left            =   90
         TabIndex        =   26
         Top             =   2250
         Width           =   1770
      End
      Begin VB.Label Label2 
         Caption         =   "Chromosome 2:"
         Height          =   195
         Index           =   8
         Left            =   90
         TabIndex        =   25
         Top             =   1845
         Width           =   1770
      End
      Begin VB.Label Label2 
         Caption         =   "Chromosome 1:"
         Height          =   195
         Index           =   7
         Left            =   90
         TabIndex        =   24
         Top             =   1440
         Width           =   1770
      End
      Begin VB.Label Label2 
         Caption         =   "Bloob Fitness:"
         Height          =   195
         Index           =   6
         Left            =   90
         TabIndex        =   23
         Top             =   1035
         Width           =   1770
      End
      Begin VB.Label Label2 
         Caption         =   "Evaluated Value:"
         Height          =   195
         Index           =   5
         Left            =   90
         TabIndex        =   22
         Top             =   225
         Width           =   1770
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "Best of the Generation"
      Height          =   2265
      Left            =   1980
      TabIndex        =   15
      ToolTipText     =   "Best of the Generation Bloob"
      Top             =   225
      Width           =   1995
      Begin VB.Label lblBGC3 
         AutoSize        =   -1  'True
         Caption         =   "-----"
         Height          =   195
         Left            =   315
         TabIndex        =   33
         Top             =   2025
         Width           =   225
      End
      Begin VB.Label lblBGC2 
         AutoSize        =   -1  'True
         Caption         =   "-----"
         Height          =   195
         Left            =   315
         TabIndex        =   32
         Top             =   1665
         Width           =   225
      End
      Begin VB.Label lblBGC1 
         AutoSize        =   -1  'True
         Caption         =   "-----"
         Height          =   195
         Left            =   315
         TabIndex        =   31
         Top             =   1260
         Width           =   225
      End
      Begin VB.Label lblBGFit 
         AutoSize        =   -1  'True
         Caption         =   "-----"
         Height          =   195
         Left            =   315
         TabIndex        =   30
         Top             =   810
         Width           =   225
      End
      Begin VB.Label lblBGVal 
         AutoSize        =   -1  'True
         Caption         =   "-----"
         Height          =   195
         Left            =   315
         TabIndex        =   29
         Top             =   405
         Width           =   225
      End
      Begin VB.Label Label2 
         Caption         =   "Chromosome 3:"
         Height          =   195
         Index           =   4
         Left            =   90
         TabIndex        =   21
         Top             =   1845
         Width           =   1770
      End
      Begin VB.Label Label2 
         Caption         =   "Chromosome 2:"
         Height          =   195
         Index           =   3
         Left            =   90
         TabIndex        =   20
         Top             =   1440
         Width           =   1770
      End
      Begin VB.Label Label2 
         Caption         =   "Chromosome 1:"
         Height          =   195
         Index           =   2
         Left            =   90
         TabIndex        =   19
         Top             =   1035
         Width           =   1770
      End
      Begin VB.Label Label2 
         Caption         =   "Bloob Fitness:"
         Height          =   195
         Index           =   1
         Left            =   90
         TabIndex        =   18
         Top             =   630
         Width           =   1770
      End
      Begin VB.Label Label2 
         Caption         =   "Evaluated Value:"
         Height          =   195
         Index           =   0
         Left            =   90
         TabIndex        =   17
         Top             =   225
         Width           =   1770
      End
   End
   Begin VB.Frame frmControl 
      Caption         =   "Control Panel"
      Height          =   5145
      Left            =   45
      TabIndex        =   0
      ToolTipText     =   "Where modifications can be made"
      Top             =   45
      Width           =   1860
      Begin VB.TextBox txtOptimum 
         Height          =   285
         Left            =   90
         TabIndex        =   13
         Text            =   "42"
         ToolTipText     =   "The target value of the function given the chromosomes of each bloob"
         Top             =   3840
         Width           =   1695
      End
      Begin VB.CheckBox chkElite 
         Caption         =   "Elitism"
         Height          =   195
         Left            =   90
         TabIndex        =   12
         ToolTipText     =   "Elitism is where the best of each generation survives to the next generation"
         Top             =   4275
         Value           =   1  'Checked
         Width           =   1680
      End
      Begin VB.TextBox txtLifeTime 
         Height          =   285
         Left            =   90
         TabIndex        =   10
         Text            =   "0"
         ToolTipText     =   "How quickly each life cycle happens, anything below 50 is considered 0"
         Top             =   3150
         Width           =   1695
      End
      Begin VB.CommandButton cmdBreed 
         Caption         =   "Breed"
         Height          =   435
         Left            =   90
         TabIndex        =   5
         ToolTipText     =   "Start the breeding of the bloobs"
         Top             =   4590
         Width           =   1680
      End
      Begin VB.TextBox txtPopSize 
         Height          =   285
         Left            =   90
         TabIndex        =   4
         Text            =   "32"
         ToolTipText     =   "The number of Bloobs in the Population"
         Top             =   465
         Width           =   1695
      End
      Begin VB.TextBox txtGens 
         Height          =   285
         Left            =   90
         TabIndex        =   3
         Text            =   "128"
         ToolTipText     =   "How many generations to cycle before giving a result"
         Top             =   1140
         Width           =   1695
      End
      Begin VB.TextBox txtCrossProb 
         Height          =   285
         Left            =   90
         TabIndex        =   2
         Text            =   "0.85"
         ToolTipText     =   "The chances that a crossover will happen and a new bloob is formed"
         Top             =   1845
         Width           =   1695
      End
      Begin VB.TextBox txtMutProb 
         Height          =   285
         Left            =   90
         TabIndex        =   1
         Text            =   "0.05"
         ToolTipText     =   "The chances a mutation will occur, small is good"
         Top             =   2490
         Width           =   1695
      End
      Begin VB.Label Label1 
         Caption         =   "Optimum Value"
         Height          =   255
         Index           =   5
         Left            =   90
         TabIndex        =   14
         ToolTipText     =   "The target value of the function given the chromosomes of each bloob"
         Top             =   3600
         Width           =   1695
      End
      Begin VB.Label Label1 
         Caption         =   "Life Cycle Time (ms)"
         Height          =   255
         Index           =   4
         Left            =   90
         TabIndex        =   11
         ToolTipText     =   "How quickly each life cycle happens, anything below 50 is considered 0"
         Top             =   2925
         Width           =   1695
      End
      Begin VB.Label Label1 
         Caption         =   "Population size"
         Height          =   255
         Index           =   0
         Left            =   90
         TabIndex        =   9
         ToolTipText     =   "The number of Bloobs in the Population"
         Top             =   225
         Width           =   1695
      End
      Begin VB.Label Label1 
         Caption         =   "Number of Generations"
         Height          =   255
         Index           =   1
         Left            =   90
         TabIndex        =   8
         ToolTipText     =   "How many generations to cycle before giving a result"
         Top             =   900
         Width           =   1695
      End
      Begin VB.Label Label1 
         Caption         =   "Crossover Probability"
         Height          =   255
         Index           =   2
         Left            =   90
         TabIndex        =   7
         ToolTipText     =   "The chances that a crossover will happen and a new bloob is formed"
         Top             =   1575
         Width           =   1695
      End
      Begin VB.Label Label1 
         Caption         =   "Mutation Probability"
         Height          =   255
         Index           =   3
         Left            =   90
         TabIndex        =   6
         ToolTipText     =   "The chances a mutation will occur, small is good"
         Top             =   2250
         Width           =   1695
      End
   End
   Begin VB.Label lblCurrgen 
      AutoSize        =   -1  'True
      Caption         =   "Current Generation: ---"
      Height          =   195
      Left            =   1980
      TabIndex        =   40
      Top             =   0
      Width           =   1560
   End
   Begin VB.Label lblInfostuff 
      Alignment       =   2  'Center
      Caption         =   "A Genetic Algorithm test by S鋟re of Ghostly Embers in May 2002.  Its open-source, help keep source free!"
      Height          =   420
      Left            =   45
      TabIndex        =   28
      Top             =   5220
      Width           =   3960
   End
End
Attribute VB_Name = "frmGA"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdBreed_Click()

If IsNumeric(txtPopSize) And IsNumeric(txtGens) And IsNumeric(txtCrossProb) And IsNumeric(txtMutProb) And IsNumeric(txtLifeTime) And IsNumeric(txtOptimum) = True Then
Else
    MsgBox "All values must be numeric!", , "User Error"
    Exit Sub
End If
If Val(txtPopSize) < 4 Then
    MsgBox "Population Size must be larger than 3", , "User Error"
    Exit Sub
ElseIf Val(txtPopSize) > 4097 Then
    MsgBox "Population Size must be smaller than 4097", , "User Error"
    Exit Sub
End If
If Val(txtGens) < 5 Then
    MsgBox "Generations ran must be larger than 4", , "User Error"
    Exit Sub
End If
If Val(txtCrossProb) < 0.1 Then
    MsgBox "Crossover probability must be atleast 0.1", , "User Error"
    Exit Sub
ElseIf Val(txtCrossProb) > 1 Then
    MsgBox "Crossover probability must be no more than 1", , "User Error"
    Exit Sub
End If
If Val(txtMutProb) < 0 Then
    MsgBox "Mutation probability must be atleast 0", , "User Error"
    Exit Sub
ElseIf Val(txtMutProb) > 1 Then
    MsgBox "Mutation probability must be no more than 1", , "User Error"
    Exit Sub
End If

frmControl.Enabled = False
Breed_Them
frmControl.Enabled = True

End Sub

Private Sub Form_Load()

Me.Width = 4125
Me.Height = 6015
Me.Show

End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -