antmax.frm

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

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  '窗口缺省
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_Load()
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
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
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
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 Fmax(1 To Quyu) As Double
ReDim LL(1 To 9, 1 To Quyu) As Double
Dim XOmax As Double, XNmax As Double, FFmax As Double, Xmax1 As Double, Xmax2 As Double, Fxmax1 As Double, Fxmax2 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
XNmax = 0: XOmax = 0: DeTao = 0
Up = 2.048: Down = -2.048: Chep = 0

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) = Hanshu(X01(i, j), X02(i, j))
  Next j
Next i
For j = 1 To Quyu
  For i = 1 To 9
    If Fmax(j) < F(i, j) Then
      Fmax(j) = F(i, j)
      Xmax1 = X1(i, j): Xmax2 = X2(i, j)
    End If
  Next i
  If FFmax < Fmax(j) Then
    FFmax = Fmax(j)
    XNmax = Sqr(Xmax1 ^ 2 + Xmax2 ^ 2)
    Fxmax1 = Xmax1: Fxmax2 = Xmax2
  End If
Next j

Cycle = 0
Do While (Cycle < 40)
 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 200 '每次迭代随机循环搜索100次

    For i = 1 To 9
      For j = 1 To Quyu
        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)
      Next j
    Next i


    For m = 1 To 9

      Jump = False
      For i = 1 To Quyu
        If (i <> Jqu(m)) Then
          Enta = Fmax(i) - Fmax(Jqu(m))
          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
      For j = 1 To Quyu
        F(i, j) = Hanshu(X1(i, j), X2(i, j)): F0(i, j) = Hanshu(X01(i, j), X02(i, j))
        LL(i, j) = F(i, j) - F0(i, j)
      Next j
    Next i
    
    For j = 1 To Quyu
      For i = 1 To 9
        If Fmax(j) < F(i, j) Then
          Fmax(j) = F(i, j)
          Xmax1 = X1(i, j): Xmax2 = X2(i, j)
        End If
      Next i
      If FFmax < Fmax(j) Then
        FFmax = Fmax(j)
        XNmax = Sqr(Xmax1 ^ 2 + Xmax2 ^ 2)
        Fxmax1 = Xmax1: Fxmax2 = Xmax2
      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
      Next j
      Tao(i) = Lou * Tao(i) + Mdetao
      Mdetao = 0
    Next i

  Next k

  Debug.Print Cycle
  If (XNmax - XOmax) < Zig Then Debug.Print FFmax, Fxmax1, Fxmax2
  
  XOmax = XNmax

Loop

  
End Sub
Function Hanshu(x, y) As Double
Hanshu = -1
Hanshu = x
' 100 * (y - x ^ 2) ^ 2 + (1 - x) ^ 2 ' x + y '(x ^ 3 + 3 * x ^ 2 - 9 * x) ' -(100 * (y - x ^ 2) ^ 2 + (1 - x) ^ 2) '
End Function