antmix.frm

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

VERSION 5.00
Begin VB.Form Form4 
   AutoRedraw      =   -1  'True
   Caption         =   "Form4"
   ClientHeight    =   3825
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   5310
   LinkTopic       =   "Form4"
   ScaleHeight     =   3825
   ScaleWidth      =   5310
   StartUpPosition =   3  '窗口缺省
End
Attribute VB_Name = "Form4"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_Load()
Me.Scale (-50, 100)-(280, -280)
Line (0, -250)-(0, 50)
CurrentX = -10: CurrentY = 40: Print "f2"
Line (0, -250)-(250, -250)
CurrentX = 240: CurrentY = -255: Print "f1"
For i = -1 To 5
  Line (10, -50 * i)-(0, -50 * i)
  CurrentX = -35: CurrentY = -50 * i + 10: Print Format(-50 * i, "0.0")
Next i
For i = 1 To 5
  Line (50 * i, -245)-(50 * i, -250): Print Format(50 * i, "0.0")
Next i




Dim AlfaSe As Double, BitaSe As Double, LouSe As Double, QSe As Integer, NSe As Integer, LSe As Integer, ZigSe As Double
Dim QuyuSe As Integer
AlfaSe = 1: BitaSe = 1.5: LouSe = 0.7: QSe = 1: NSe = 10: LSe = 10: ZigSe = 0.0001: QuyuSe = NSe * LSe
'吸引强度及其变化量的定义

ReDim TaoSe(1 To QuyuSe) As Double
Dim DeTaoSe As Double
For i = 1 To QuyuSe
  TaoSe(i) = 1
  Next i
Dim PiSe As Double, EntaSe As Double
ReDim FSe(1 To 9, 1 To QuyuSe) As Double, F0Se(1 To 9, 1 To QuyuSe) As Double
ReDim X1Se(1 To 9, 1 To QuyuSe) As Double, X2Se(1 To 9, 1 To QuyuSe) As Double
ReDim X01Se(1 To 9, 1 To QuyuSe) As Double, X02Se(1 To 9, 1 To QuyuSe) As Double
ReDim FminSe(1 To QuyuSe) As Double
ReDim LLSe(1 To 9, 1 To QuyuSe) As Double
Dim FFminSe As Double, Xmin1Se As Double, Xmin2Se As Double, Fxmin1Se As Double, Fxmin2Se As Double
Dim Posx1Se(1 To 9) As Integer, Posx2Se(1 To 9) As Integer, JquSe(1 To 9) As Integer
'随机放置9组蚂蚁的位置，及其所属区域
Dim JumpSe As Boolean
Dim MdetaoSe As Double

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 = NSe: L = LSe: 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 Fmin(1 To Quyu) As Double
ReDim LL(1 To 9, 1 To Quyu) As Double
Dim 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 Up As Double, Down As Double, Chep As Double
Dim ReforX As Double, ReforY As Double
ReDim FforF1(1 To 9, 1 To QuyuSe) As Double '把f1置于f2一样的取值范围，一样的取值点情况下的目标函数值
ReDim Fforf1min(1 To QuyuSe) As Double

Dim ComF1 As Double, ComF2 As Double, ComF3 As Double

DeTao = 0
'Up = 20: Down = -20: Chep = 0
UpX = 13.85: DownX = -Sqr(255): Chep = 0
UpY = Sqr(255): DownY = -1.95
Mdetao = 0


Dim Cycle As Integer, ForI As Integer

Dim UpSe As Double, DownSe As Double, ChepSe As Double

Dim Ncycle As Integer, Nk As Integer
DeTaoSe = 0
'UpSeX = 13.85: DownSeX = -Sqr(255): ChepSe = 0
'UpSeY = Sqr(255): DownSeY = -1.95
UpSeX = 13.85: DownSeX = -Sqr(255): ChepSe = 0
UpSeY = Sqr(255): DownSeY = -1.95
Ncycle = 20: Nk = 100

'Dim Bix As Double, Biy As Double
'
'For kk = 1 To 10
' UpSeX = kk * 29.81 / 10 - 15.96

MdetaoSe = 0
For i = 1 To 9
  For j = 1 To QuyuSe
    LLSe(i, j) = 0
    X01Se(i, j) = DownSeX + (UpSeX - DownSeX) * (Int(Rnd() * NSe) + 1 - 1 + Rnd()) / NSe
    If (X01Se(i, j) <= 13.85 And X01Se(i, j) >= -15.85) Then
      UpSeY = Sqr(255 - X01Se(i, j) ^ 2): DownSeY = (X01Se(i, j) + 10) / 3
      Else
      UpSeY = Sqr(255 - X01Se(i, j) ^ 2): DownSeY = -Sqr(255 - X01Se(i, j) ^ 2)
    End If
    
    X02Se(i, j) = DownSeY + (UpSeY - DownSeY) * (Int(Rnd() * LSe) + 1 - 1 + Rnd()) / LSe
    X1Se(i, j) = X01Se(i, j): X2Se(i, j) = X02Se(i, j)
    FSe(i, j) = HanshuSe(X01Se(i, j), X02Se(i, j))
  Next j
Next i
For j = 1 To QuyuSe
  FminSe(j) = 100000 'FSe(1, j)
Next j
  FFminSe = 100000 'FminSe(1)

For j = 1 To QuyuSe
  For i = 1 To 9
    If FminSe(j) > FSe(i, j) Then
      FminSe(j) = FSe(i, j)
      Xmin1Se = X1Se(i, j): Xmin2Se = X2Se(i, j)
    End If
  Next i
  If FFminSe > FminSe(j) Then
    FFminSe = FminSe(j)
    Fxmin1Se = Xmin1Se: Fxmin2Se = Xmin2Se
  End If
Next j


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) = DownX + (UpX - DownX) * (ForI - 1 + Rnd()) / N
    X02(i, j) = DownY + (UpY - DownY) * ((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
  Fmin(j) = 100000 ' F(1, j)
Next j
  FFmin = 100000 '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)
    Fxmin1 = Xmin1: Fxmin2 = Xmin2
  End If
Next j

'Open App.Path & "\f2data.txt" For Output As #1

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)
    Posx1Se(m) = Int(Rnd() * NSe) + 1: Posx2Se(m) = Int(Rnd() * LSe) + 1: JquSe(m) = (Posx1Se(m) - 1) * NSe + Posx2Se(m)
  Next m
  
  For k = 1 To Nk '每次迭代随机循环搜索100次
'   Debug.Print JquSe(1), JquSe(2), JquSe(3), JquSe(4), JquSe(5), JquSe(6), JquSe(7), JquSe(8), JquSe(9)
'
    Sel = True
    For i = 1 To 9
      For j = 1 To QuyuSe
        X01Se(i, j) = DownSeX + (UpSeX - DownSeX) * (Int(Rnd() * NSe) + 1 - 1 + Rnd()) / NSe
        If (X01Se(i, j) <= 13.85 And X01Se(i, j) >= -15.85) Then
          UpSeY = Sqr(255 - X01Se(i, j) ^ 2): DownSeY = (X01Se(i, j) + 10) / 3
          Else
          UpSeY = Sqr(255 - X01Se(i, j) ^ 2): DownSeY = -Sqr(255 - X01Se(i, j) ^ 2)
        End If
        X02Se(i, j) = DownSeY + (UpSeY - DownSeY) * (Int(Rnd() * LSe) + 1 - 1 + Rnd()) / LSe
        X1Se(i, j) = X01Se(i, j): X2Se(i, j) = X02Se(i, j)
      Next j
    Next i

    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

      JumpSe = False
      For i = 1 To QuyuSe
        If (i <> JquSe(m)) Then
          EntaSe = FminSe(JquSe(m)) - FminSe(i)
          If EntaSe > 0 Then
            PiSe = TaoSe(i) ^ AlfaSe * EntaSe ^ BitaSe
            JumpSe = True
            Else
            PiSe = 0
          End If
          Else
            PiSe = 0
        End If
        If ChepSe < PiSe Then
          ChepSe = PiSe
          JquSe(m) = i
        End If
      Next i
      ChepSe = 0
      
      If JumpSe = True Then
        If (JquSe(m) Mod NSe = 0) Then
          Posx1Se(m) = JquSe(m) / NSe: Posx2Se(m) = JquSe(m) - (Posx1Se(m) - 1) * NSe
          Else
          Posx1Se(m) = Int(JquSe(m) / NSe) + 1: Posx2Se(m) = JquSe(m) - (Posx1Se(m) - 1) * NSe
        End If
          X01Se(m, JquSe(m)) = DownSeX + (UpSeX - DownSeX) * (Posx1Se(m) - 1 + Rnd()) / NSe
          If (X01Se(m, JquSe(m)) <= 13.85 And X01Se(m, JquSe(m)) >= -15.85) Then
            UpSeY = Sqr(255 - X01Se(m, JquSe(m)) ^ 2): DownSeY = (X01Se(m, JquSe(m)) + 10) / 3
            Else
            UpSeY = Sqr(255 - X01Se(m, JquSe(m)) ^ 2): DownSeY = -Sqr(255 - X01Se(m, JquSe(m)) ^ 2)
          End If
          X02Se(m, JquSe(m)) = DownSeY + (UpSeY - DownSeY) * (Posx2Se(m) - 1 + Rnd()) / LSe
          X1Se(m, JquSe(m)) = DownSeX + (UpSeX - DownSeX) * (Posx1Se(m) - 1 + Rnd()) / NSe
          X2Se(m, JquSe(m)) = DownSeY + (UpSeY - DownSeY) * (Posx2Se(m) - 1 + Rnd()) / LSe
      End If
      If JumpSe = False Then
         X01Se(m, JquSe(m)) = DownSeX + (UpSeX - DownSeX) * (Posx1Se(m) - 1 + Rnd()) / NSe
         If (X01Se(m, JquSe(m)) <= 13.85 And X01Se(m, JquSe(m)) >= -15.85) Then
            UpSeY = Sqr(255 - X01Se(m, JquSe(m)) ^ 2): DownSeY = (X01Se(m, JquSe(m)) + 10) / 3
            Else
            UpSeY = Sqr(255 - X01Se(m, JquSe(m)) ^ 2): DownSeY = -Sqr(255 - X01Se(m, JquSe(m)) ^ 2)
         End If
         X02Se(m, JquSe(m)) = DownSeY + (UpSeY - DownSeY) * (Posx2Se(m) - 1 + Rnd()) / LSe
         X1Se(m, JquSe(m)) = DownSeX + (UpSeX - DownSeX) * (Posx1Se(m) - 1 + Rnd()) / NSe
         X2Se(m, JquSe(m)) = DownSeY + (UpSeY - DownSeY) * (Posx2Se(m) - 1 + Rnd()) / LSe
      End If
      
      
      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)) = DownX + (UpX - DownX) * (Posx1(m) - 1 + Rnd()) / N
          X02(m, Jqu(m)) = DownY + (UpY - DownY) * (Posx2(m) - 1 + Rnd()) / L
          X1(m, Jqu(m)) = DownX + (UpX - DownX) * (Posx1(m) - 1 + Rnd()) / N
          X2(m, Jqu(m)) = DownY + (UpY - DownY) * (Posx2(m) - 1 + Rnd()) / L
      End If
      If Jump = False Then
         X01(m, Jqu(m)) = DownX + (UpX - DownX) * (Posx1(m) - 1 + Rnd()) / N
         X02(m, Jqu(m)) = DownY + (UpY - DownY) * (Posx2(m) - 1 + Rnd()) / L
         X1(m, Jqu(m)) = DownX + (UpX - DownX) * (Posx1(m) - 1 + Rnd()) / N
         X2(m, Jqu(m)) = DownY + (UpY - DownY) * (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 Fmin(j) > F(i, j) Then
          Fmin(j) = F(i, j)
          Xmin1 = X1(i, j): Xmin2 = X2(i, j)
'          Me.PSet (Fmin(j), HanshuSe(Xmin1, Xmin2)), RGB(255, 0, 0) '根据f1的收敛点画
        End If

      Next i
      If FFmin > Fmin(j) Then
        FFmin = Fmin(j)
        Fxmin1 = Xmin1: Fxmin2 = Xmin2
      End If
    Next j
    
    For i = 1 To 9
      ComF1 = 10000
      For j = 1 To QuyuSe
        FSe(i, j) = HanshuSe(X1Se(i, j), X2Se(i, j)): F0Se(i, j) = HanshuSe(X01Se(i, j), X02Se(i, j))
        LLSe(i, j) = FSe(i, j) - F0Se(i, j)
        FforF1(i, j) = Hanshu(X1Se(i, j), X2Se(i, j))
        Fforf1min(j) = FforF1(1, j)
        Me.PSet (Hanshu(X1Se(i, j), X2Se(i, j)), FSe(i, j)), RGB(255, 0, 0)
        If ComF1 > Hanshu(X1Se(i, j), X2Se(i, j)) Then
          ComF1 = Hanshu(X1Se(i, j), X2Se(i, j))
          ComF2 = FSe(i, j)
          ReforX = X1Se(i, j): ReforY = X2Se(i, j)
        End If
      Next j
      Me.PSet (ComF1, ComF2), RGB(255, 0, 0)
'      Print #1, Hanshu(ReforX, ReforY), ComF2, ReforX, ReforY
'      Me.Circle (ComF1, ComF2), 2, RGB(255, 0, 0)
    Next i
   
    For j = 1 To QuyuSe
      ComF1 = 10000
      For i = 1 To 9
        If FminSe(j) > FSe(i, j) Then
          FminSe(j) = FSe(i, j)
          Xmin1Se = X1Se(i, j): Xmin2Se = X2Se(i, j)
'          Me.PSet (Hanshu(Xmin1Se, Xmin2Se), FminSe(j)) '根据f2的收敛点画
          If ComF1 > Hanshu(X1Se(i, j), X2Se(i, j)) Then
            ComF1 = Hanshu(X1Se(i, j), X2Se(i, j))
            ComF2 = FSe(i, j)
            ReforX = Xmin1Se: ReforY = Xmin2Se
          End If
        End If

'        If Fmin(j) > FforF1(i, j) Then
'          Fmin(j) = FforF1(i, j)
'          Me.PSet (Fmin(j), FminSe(j)), RGB(255, 0, 0)
'        End If
        
      Next i
'      Me.Circle (ComF1, ComF2), 2, RGB(255, 0, 0)
       Me.PSet (ComF1, ComF2), RGB(255, 0, 0)
'       Print #1, Hanshu(ReforX, ReforY), ComF2, ReforX, ReforY


      If FFminSe > FminSe(j) Then
        FFminSe = FminSe(j)
        Fxmin1Se = Xmin1Se: Fxmin2Se = Xmin2Se
      End If
    Next j
  
    For i = 1 To QuyuSe
      For j = 1 To 9
        If LLSe(j, i) < 0 Then
          DeTaoSe = -QSe * LLSe(j, i)
          Else
          DeTaoSe = 0
        End If
        MdetaoSe = MdetaoSe + DeTaoSe
      Next j
      TaoSe(i) = LouSe * TaoSe(i) + MdetaoSe
      MdetaoSe = 0
    Next i
    
    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
'  Debug.Print FFminSe, Fxmin1Se, Fxmin2Se 'FFmin, Fxmin1, Fxmin2 '
'  Me.Circle (FFmin, FFminSe), 10, RGB(255, 0, 0)
Loop
'Next kk
' Close #1
End Sub
Function Hanshu(x As Double, y As Double) As Double '对应的是没有se结尾的那一套变量

Hanshu = (x - 2) ^ 2 + (y - 1) ^ 2 + 2                                                           '函数组2-1
'100 * (y - x ^ 2) ^ 2 + (1 - x) ^ 2
'
'(x ^ 3 + 3 * x ^ 2 - 9 * x)
' -(100 * (y - x ^ 2) ^ 2 + (1 - x) ^ 2) '
End Function
Function HanshuSe(x As Double, y As Double) As Double '对应的是有se结尾的那一套变量

HanshuSe = 9 * x - (y - 1) ^ 2 '函数组2-2
' + y ' (1 + 10 * y) * (1 - (x / (1 + 10 * y)) ^ 2 - x * Sin(2 * 3.1416 * 4 * x) / (1 + 10 * y))  '100 * (y - x ^ 2) ^ 2 + (1 - x) ^ 2
'
'(x ^ 3 + 3 * x ^ 2 - 9 * x)
' -(100 * (y - x ^ 2) ^ 2 + (1 - x) ^ 2) '
End Function