liyi.frm

这是一个基于Visual Basic的算法程序

VERSION 5.00
Begin VB.Form Form5 
   AutoRedraw      =   -1  'True
   Caption         =   "liyi"
   ClientHeight    =   3090
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   4680
   LinkTopic       =   "Form5"
   ScaleHeight     =   3090
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
End
Attribute VB_Name = "Form5"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_Load()
'Me.Scale (-0.2, 1.2)-(1, -0.7)
'Line (0, -0.5)-(0, 1.2)
'CurrentX = -0.1: CurrentY = 1.2: Print "f2"
'Line (0, -0.5)-(1, -0.5)
'CurrentX = 0.9: CurrentY = -0.6: Print "f1"
'For i = 1 To 8
'  Line (0.025, -0.4 + i * 0.2 - 0.2)-(0, -0.4 + i * 0.2 - 0.2)
'  CurrentX = -0.1: CurrentY = i * 0.2 - 0.55: Print Format(-0.6 + i * 0.2, "0.0")
'Next i
'For i = 1 To 5
'  Line (0.2 * i, -0.45)-(0.2 * i, -0.5): Print Format(0.2 * i, "0.0")
'Next i
Me.Scale (-10, 20)-(10, -2)
Line (-10, 0)-(10, 0)
Line (0, 0)-(0, 20)


Dim Alfa As Double, Bita As Double, Lou As Double, Q As Integer, N As Integer, L As Integer, Zig As Double
Dim Quyu As Integer '把二维空间划分成n行l列的区域总数
Alfa = 1: Bita = 1.5: Lou = 0.7: Q = 1: N = 10: L = 10: Zig = 0.0001: Quyu = N * L
'吸引强度及其变化量的定义

ReDim Tao(1 To Quyu) As Double '对于每一个区域给定一个吸引强度，按照吸引强度计算转移概率
Dim DeTao As Double '信息量增加最大量, TaoMax As Double
For i = 1 To Quyu
  Tao(i) = 1
  Next
Dim Pi As Double, Enta As Double
ReDim F(1 To 9, 1 To Quyu) As Double, F0(1 To 9, 1 To Quyu) As Double '记录9组蚂蚁，在所有可能区域上的目标函数值
ReDim X1(1 To 9, 1 To Quyu) As Double, X2(1 To 9, 1 To Quyu) As Double '所有区域每次搜索的结束点
ReDim X01(1 To 9, 1 To Quyu) As Double, X02(1 To 9, 1 To Quyu) As Double '搜索的开始点
ReDim Fmin(1 To Quyu) As Double '搜索一次之后记录每个区域的最小目标值，不管是否有蚂蚁在这个区域上
ReDim LL(1 To 9, 1 To Quyu) As Double '目标函数开始点和结束点的差值
Dim XOmin As Double, XNmin As Double, FFmin As Double, Xmin1 As Double, Xmin2 As Double, Fxmin1 As Double, Fxmin2 As Double '记录每一次循环的最大值和对应的变量
Dim Posx1(1 To 9) As Integer, Posx2(1 To 9) As Integer, Jqu(1 To 9) As Integer '记录9组蚂蚁的行列位置，及其所属区域，行列与区域之间有确定的关系
Dim Jump As Boolean '判断一组蚂蚁是否要转移搜索的区域
Dim Mdetao As Double
Dim Cycle As Integer, ForI As Integer
Dim Up As Double, Down As Double, Chep As Double '变量的上下限，这里两个变量的上下限设定为相同
Dim Ncycle As Integer, Nk As Integer '定义迭代次数，以及每次迭代包含的循环次数，每次循环包括蚂蚁的转移，以及转移后的搜索，和没有转移的搜索，和没有蚂蚁的区域的搜索
XNmin = 0: XOmin = 0: DeTao = 0
Up = 30: Down = -30: Chep = 0
Ncycle = 20: Nk = 100


Open App.Path & "\fun1data.txt" For Output As #1
Mdetao = 0
For i = 1 To 9 '每一个区域初始化的设定搜索开始点和结束点
  For j = 1 To Quyu
    LL(i, j) = 0
     If (j Mod N = 0) Then '计算行列坐标，求得每一个区域对应的x，y分区位置
          ForI = j / N
          Else
          ForI = Int(j / N) + 1
        End If
     X01(i, j) = Down + (Up - Down) * (ForI - 1 + Rnd()) / N
     X02(i, j) = Down + (Up - Down) * ((j - ForI * N + N) - 1 + Rnd()) / L
    X1(i, j) = X01(i, j): X2(i, j) = X02(i, j)
    F(i, j) = Hanshu1(X01(i, j), X02(i, j))
  Next j
Next i
For j = 1 To Quyu
  Fmin(j) = 10000 'F(1, j)
Next j
  FFmin = 10000 'Fmin(1)

For j = 1 To Quyu
  For i = 1 To 9
    If Fmin(j) > F(i, j) Then '比较一次以便产生第一次的更新公式
      Fmin(j) = F(i, j)
      Xmin1 = X1(i, j): Xmin2 = X2(i, j)
    End If
  Next i
  If FFmin > Fmin(j) Then '比较每一次循环的最小值
    FFmin = Fmin(j)
    XNmin = Sqr(Xmin1 ^ 2 + Xmin2 ^ 2) '如果以两次循环最小点的距离作为推出循环的依据
    Fxmin1 = Xmin1: Fxmin2 = Xmin2
  End If
Next j

Cycle = 0
Do While (Cycle < Ncycle)
 Cycle = Cycle + 1
'随机放置9组蚂蚁
  For m = 1 To 9
    Posx1(m) = Int(Rnd() * N) + 1: Posx2(m) = Int(Rnd() * L) + 1: Jqu(m) = (Posx1(m) - 1) * N + Posx2(m)
  Next m
  
  For k = 1 To Nk '每次迭代随机循环搜索100次

    For i = 1 To 9
      
      For j = 1 To Quyu
        
        If (j Mod N = 0) Then '计算行列坐标
          ForI = j / N
          Else
          ForI = Int(j / N) + 1
        End If
        X01(i, j) = Down + (Up - Down) * (ForI - 1 + Rnd()) / N
        X02(i, j) = Down + (Up - Down) * ((j - ForI * N + N) - 1 + Rnd()) / L
        X1(i, j) = X01(i, j): X2(i, j) = X02(i, j)
      Next j
    Next i


    For m = 1 To 9 '计算每一组蚂蚁的转移概率，决定转移与否

      Jump = False
      For i = 1 To Quyu
        If (i <> Jqu(m)) Then ' 比较此组蚂蚁所在的区域和其他所有区域的吸引强度
          Enta = Fmin(Jqu(m)) - Fmin(i)
          If Enta > 0 Then '如果其他区域比所在区域目标函数值要小，将发生转移
            Pi = Tao(i) ^ Alfa * Enta ^ Bita
            Jump = True
            Else
            Pi = 0
          End If
          Else
            Pi = 0
        End If
        If Chep < Pi Then '比较和记录转移概率最大的一个区域
          Chep = Pi
          Jqu(m) = i
        End If
      Next i
      Chep = 0
      
      If Jump = True Then '如果转移，更改蚂蚁所在的行列坐标到概率最大的一个区域并且给出这个区域的搜索起始点和结束点
        If (Jqu(m) Mod N = 0) Then '计算行列坐标
          Posx1(m) = Jqu(m) / N: Posx2(m) = Jqu(m) - (Posx1(m) - 1) * N
          Else
          Posx1(m) = Int(Jqu(m) / N) + 1: Posx2(m) = Jqu(m) - (Posx1(m) - 1) * N
        End If
          X01(m, Jqu(m)) = Down + (Up - Down) * (Posx1(m) - 1 + Rnd()) / N
          X02(m, Jqu(m)) = Down + (Up - Down) * (Posx2(m) - 1 + Rnd()) / L
          X1(m, Jqu(m)) = Down + (Up - Down) * (Posx1(m) - 1 + Rnd()) / N
          X2(m, Jqu(m)) = Down + (Up - Down) * (Posx2(m) - 1 + Rnd()) / L
      End If
      If Jump = False Then '如果不发生转移重新设定蚂蚁所在区域的搜索起始点和结束点
         X01(m, Jqu(m)) = Down + (Up - Down) * (Posx1(m) - 1 + Rnd()) / N
         X02(m, Jqu(m)) = Down + (Up - Down) * (Posx2(m) - 1 + Rnd()) / L
         X1(m, Jqu(m)) = Down + (Up - Down) * (Posx1(m) - 1 + Rnd()) / N
         X2(m, Jqu(m)) = Down + (Up - Down) * (Posx2(m) - 1 + Rnd()) / L
      End If
    
    Next m
    
    For i = 1 To 9 '计算所有区域的搜索点目标函数值，每个区域有没蚂蚁都将被搜索9次
      For j = 1 To Quyu
        F(i, j) = Hanshu1(X1(i, j), X2(i, j)): F0(i, j) = Hanshu1(X01(i, j), X02(i, j))
        LL(i, j) = F(i, j) - F0(i, j)
        Me.PSet (X1(i, j), F(i, j)), RGB(255, 0, 0) '描出所有点

      Next j
    Next i
    For j = 1 To Quyu
      For i = 1 To 9
        If Fmin(j) > F(i, j) Then
        
          Fmin(j) = F(i, j)
          Xmin1 = X1(i, j): Xmin2 = X2(i, j)
          
'          Me.PSet (X1(i, j), F(i, j)), RGB(255, 0, 0) '描出每次循环中每一个区域内的最小点
          Me.Circle (X1(i, j), F(i, j)), 0.05, RGB(255, 0, 0)
          Print #1, X1(i, j), X2(i, j), F(i, j)
'          Me.PSet (X1(i, j), X2(i, j)), RGB(255, 0, 0)
        End If
      Next i
      If FFmin > Fmin(j) Then
        FFmin = Fmin(j)
        Fxmin1 = Xmin1: Fxmin2 = Xmin2
'        Me.Circle (Xmin1, FFmin), 0.005, RGB(0, 255, 0)
      End If
    Next j
    

    For i = 1 To Quyu
      For j = 1 To 9
        If LL(j, i) < 0 Then '用目标函数值的差值来计算更新公式的强度
          DeTao = -Q * LL(j, i)
          Else
          DeTao = 0
        End If
        Mdetao = Mdetao + DeTao '每一个区域搜索9次所得到的信息增量总和
      Next j
      Tao(i) = Lou * Tao(i) + Mdetao '更新吸引强度
      Mdetao = 0
    Next i

  Next k


Loop
Close #1

Open App.Path & "\fun2data.txt" For Output As #1
Mdetao = 0
For i = 1 To 9 '每一个区域初始化的设定搜索开始点和结束点
  For j = 1 To Quyu
    LL(i, j) = 0
     If (j Mod N = 0) Then '计算行列坐标，求得每一个区域对应的x，y分区位置
          ForI = j / N
          Else
          ForI = Int(j / N) + 1
        End If
     X01(i, j) = Down + (Up - Down) * (ForI - 1 + Rnd()) / N
     X02(i, j) = Down + (Up - Down) * ((j - ForI * N + N) - 1 + Rnd()) / L
    X1(i, j) = X01(i, j): X2(i, j) = X02(i, j)
    F(i, j) = Hanshu2(X01(i, j), X02(i, j))
  Next j
Next i
For j = 1 To Quyu
  Fmin(j) = 10000 'F(1, j)
Next j
  FFmin = 10000 'Fmin(1)

For j = 1 To Quyu
  For i = 1 To 9
    If Fmin(j) > F(i, j) Then '比较一次以便产生第一次的更新公式
      Fmin(j) = F(i, j)
      Xmin1 = X1(i, j): Xmin2 = X2(i, j)
    End If
  Next i
  If FFmin > Fmin(j) Then '比较每一次循环的最小值
    FFmin = Fmin(j)
    XNmin = Sqr(Xmin1 ^ 2 + Xmin2 ^ 2) '如果以两次循环最小点的距离作为推出循环的依据
    Fxmin1 = Xmin1: Fxmin2 = Xmin2
  End If
Next j

Cycle = 0
Do While (Cycle < Ncycle)
 Cycle = Cycle + 1
'随机放置9组蚂蚁
  For m = 1 To 9
    Posx1(m) = Int(Rnd() * N) + 1: Posx2(m) = Int(Rnd() * L) + 1: Jqu(m) = (Posx1(m) - 1) * N + Posx2(m)
  Next m
  
  For k = 1 To Nk '每次迭代随机循环搜索100次

    For i = 1 To 9
      
      For j = 1 To Quyu
        
        If (j Mod N = 0) Then '计算行列坐标
          ForI = j / N
          Else
          ForI = Int(j / N) + 1