📄 liyi.frm

📁 这是一个基于Visual Basic的算法程序
💻 FRM
📖 第 1 页 / 共 2 页
字号:
上一页 12
        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) = Hanshu2(X1(i, j), X2(i, j)): F0(i, j) = Hanshu2(X01(i, j), X02(i, j))
        LL(i, j) = F(i, j) - F0(i, j)
        Me.PSet (X1(i, j), F(i, j)), RGB(0, 255, 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(0, 255, 0) '描出每次循环中每一个区域内的最小点
          Me.Circle (X1(i, j), F(i, j)), 0.1, RGB(0, 255, 0)
          Print #1, X1(i, j), X2(i, j), F(i, j)
'           Me.PSet (X1(i, j), X2(i, j)), RGB(0, 255, 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 & "\fun3data.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) = Hanshu3(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) = Hanshu3(X1(i, j), X2(i, j)): F0(i, j) = Hanshu3(X01(i, j), X02(i, j))
        LL(i, j) = F(i, j) - F0(i, j)
        Me.PSet (X1(i, j), F(i, j)), RGB(0, 0, 255) '描出所有点

      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(0, 0, 255) '描出每次循环中每一个区域内的最小点
          Me.Circle (X1(i, j), F(i, j)), 0.05, RGB(0, 0, 255)
          Print #1, X1(i, j), X2(i, j), F(i, j)
'          Me.PSet (X1(i, j), X2(i, j)), RGB(0, 0, 255)
        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
End Sub
Function Hanshu1(x As Double, y As Double) As Double

Hanshu1 = 0.5 * (x ^ 2 + y ^ 2) + Sin(x ^ 2 + y ^ 2)

End Function

Function Hanshu2(x As Double, y As Double) As Double

Hanshu2 = (3 * x - 2 * y + 4) ^ 2 / 8 + (x - y + 1) ^ 2 / 27 + 15

End Function
Function Hanshu3(x As Double, y As Double) As Double

Hanshu3 = 1 / (x ^ 2 + y ^ 2 + 1) - 1.1 * 2.71828 ^ (-x ^ 2 - y ^ 2)

End Function
上一页 12
💿 文件大小 1292 K
👤 上传用户 q116026490
📂 所属分类数值算法/人工智能
🏷️ 相关标签

#Visual #Basic #算法 #程序
⌨️ 快捷键说明

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