form1.frm

基于VB语言的微粒群算法

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3090
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3090
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   615
      Left            =   2520
      TabIndex        =   0
      Top             =   1560
      Width           =   1815
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Dim a(2) As Double, b(2) As Double, VaryNum%, Popsize%, MaxGeneration%, M As Double
a(1) = -2.048: a(2) = -2.048
b(1) = 2.048: b(2) = 2.048
VaryNum = 2
Popsize = 100
MaxGeneration = 2000
M = Pso(a(), b(), VaryNum, Popsize, MaxGeneration)
End Sub


Public Function Pso(amin() As Double, amax() As Double, VaryNum As Integer, Popsize As Integer, MaxGeneration As Integer)
'amin  变量的取值下限 amax 变量的取值上限
'VaryNum 变量数  MaxGeneration 最大迭代数目
'Popsize 微粒群规模
Dim i%, j%, Generation%, PNum%
Dim c1#, c2#, Rnd1#, Rnd2#, w#
'##########重定义数组变量##############
Dim InBird() As Individual, IndividualBest() As Individual, GlobalBest As Individual
ReDim GlobalBest.v(VaryNum) As Double
ReDim GlobalBest.x(VaryNum) As Double
ReDim InBird(MaxGeneration, Popsize) As Individual, IndividualBest(Popsize) As Individual
For i = 0 To MaxGeneration
    For j = 1 To Popsize
        ReDim InBird(i, j).v(VaryNum) As Double
        ReDim InBird(i, j).x(VaryNum) As Double
    Next j
Next i
For i = 1 To Popsize
    ReDim IndividualBest(i).v(VaryNum) As Double
    ReDim IndividualBest(i).x(VaryNum) As Double
Next i
'##########重定义数组变量##############

Randomize
'##########初始化微粒群##############
For i = 1 To Popsize
    For j = 1 To VaryNum
        InBird(0, i).x(j) = amin(j) + Rnd * (amax(j) - amin(j)) '初始化变量值
    Next j
Next i
For i = 1 To Popsize
    InBird(0, i).Value = FunctionObject(InBird(0, i).x())       '通过调用函数计算目标函数值
    IndividualBest(i) = InBird(0, i)                            '初始化时将初始值作为最优值
Next i
GlobalBest = IndividualBest(1)
For i = 1 To Popsize
    If GlobalBest.Value < IndividualBest(i).Value Then
       GlobalBest = IndividualBest(i)                           '寻求初始群体中的最优位置
    End If
Next i
'##########初始化微粒群##############

For Generation = 1 To MaxGeneration
    w = 0.4 - Generation * (0.8 - 0.4) / 1000      '线性调整权重因子w的值
    c1 = 2: c2 = 2                                '比例参数
    For i = 1 To Popsize
        For j = 1 To VaryNum
Recalculation:                                    '重新计算
            Rnd1 = Rnd: Rnd2 = Rnd                '产生随机数
            '产生下一代微粒移动的距离
            InBird(Generation, i).v(j) = w * InBird(Generation - 1, i).v(j) + c1 * Rnd1 * (IndividualBest(i).x(j) - InBird(Generation - 1, i).x(j)) + c2 * Rnd2 * (GlobalBest.x(j) - InBird(Generation - 1, i).x(j))
            InBird(Generation, i).x(j) = InBird(Generation - 1, i).x(j) + InBird(Generation, i).v(j)
            If InBird(Generation, i).x(j) > amax(j) Or InBird(Generation, i).x(j) < amin(j) Then
               PNum = PNum + 1
               If PNum <= 10 Then
                  GoTo Recalculation
               Else
                  InBird(Generation, i).v(j) = Rnd
                  InBird(Generation, i).x(j) = amin(j) + (amax(j) - amin(j)) * InBird(Generation, i).v(j)
               End If
            End If
            PNum = 0
        Next j
    Next i
    For i = 1 To Popsize
        InBird(Generation, i).Value = FunctionObject(InBird(Generation, i).x())
    Next i
    For i = 1 To Popsize   '寻求每一个微粒群个体运行至某一代时发现的最优位置
        If IndividualBest(i).Value < InBird(Generation, i).Value Then
           IndividualBest(i) = InBird(Generation, i)
        End If
    Next i
    For i = 1 To Popsize
        If GlobalBest.Value < IndividualBest(i).Value Then
           GlobalBest = IndividualBest(i) '寻求整个微粒群体运行至某一代时发现的最优位置
        End If
    Next i
    Debug.Print "当前运算到第"; Generation; " 代    ";
    Debug.Print "GlobalBest.Value="; GlobalBest.Value
Next Generation
    For i = 1 To VaryNum
        Debug.Print "GlobalBest.x("; i; ")="; GlobalBest.x(i)
    Next i
End Function

Public Function FunctionObject(Vary() As Double) As Double
  Dim Dimension As Integer, x() As Double
  Dimension = UBound(Vary)
  ReDim x(Dimension) As Double
  For i = 1 To Dimension
      x(i) = Vary(i)
  Next i
  FunctionObject = 100 * (x(1) ^ 2 - x(2)) * (x(1) * x(2) - x(2)) + (1 - x(1)) ^ 2           '目标函数
End Function