modulemmas.bas

蚂蚁算法实验室

Attribute VB_Name = "ModuleMMAS"
Public MaxAnts     '使用的蚂蚁只数
Public MaxCities   '城市数目
Public Alpha As Double
Public Beta As Double
Public Rou As Double
Public TaoMax As Double
Public TaoMin As Double
Public Tao0 As Double
Public MaxIter As Integer
Public W As Double
Public Sigma As Double
Public CalcTimes As Double
Public Q0 As Double
Public Type Tour_Of_Ant
  fromCity As Integer
  toCity As Integer
  Prob As Double       ''''Used to find the reason why this ant choose this path
End Type
Public Type Ant_MMAS
  Tour() As Tour_Of_Ant
  StartingCity As Integer
  CurrentCity As Integer
  Visited() As Boolean
  LengthOfPath As Double
End Type
Public Type City_Type
  x As Double
  y As Double
End Type

Public Ant() As Ant_MMAS
Public City() As City_Type
Public Dis() As Double
Public Tao() As Double
Public NTao() As Boolean

Public SignUseNew As Boolean
Public SignComputeAvg As Boolean
Public SignAlwaysCleanResult As Boolean
Public SignDrawBestLen As Boolean
Public SignDrawAvgLen As Boolean
Public SignDrawTogether As Boolean
Public SignDrawPath As Boolean
Public SignDrawTao As Boolean
Public SignShowStep_by_Step As Boolean
Public SignPause As Boolean
Public SignShowNextMove As Boolean
Public CityXMax As Double, CityXMin As Double, CityYMax As Double, CityYMin As Double
Public TaoMaxInIter As Double

Public Function Init_MMAS()
  Dim TspFile As String  '存储TSP问题的城市布局的文件
  Alpha = Val(frmMMAS.txtAlpha.Text)
  Beta = Val(frmMMAS.txtBeta.Text)
  Rou = Val(frmMMAS.txtRou.Text)
  TaoMax = Val(frmMMAS.txtTaoMax.Text)
  TaoMin = Val(frmMMAS.txtTaoMin.Text)
  MaxIter = Val(frmMMAS.txtMaxIter.Text)
  Tao0 = Val(frmMMAS.txtTao0.Text)
  Sigma = Val(frmMMAS.txtSigma)
  W = Val(frmMMAS.txtW.Text)
  CalcTimes = Val(frmMMAS.txtCalcTime.Text)
  Q0 = Val(frmMMAS.txtQ0.Text)
  MaxAnts = Val(frmMMAS.txtMaxAnts.Text)
  TspFile = frmMMAS.lstCityData.Text + ".txt"   '以上步骤把用户在软件界面中设置的参数存储在对应的变量中
  Open TspFile For Input As #1   '打开TSP文件
  Input #1, MaxCities     '从文件的第一行读出该TSP问题的城市数量
  ReDim City(1 To MaxCities)
  ReDim Ant(1 To MaxAnts)
  ReDim Dis(1 To MaxCities, 1 To MaxCities)
  ReDim Tao(1 To MaxCities, 1 To MaxCities)
  ReDim NTao(1 To MaxCities, 1 To MaxCities)
  For i = 1 To MaxAnts
    ReDim Ant(i).Tour(1 To MaxCities)
    ReDim Ant(i).Visited(1 To MaxCities)
  Next i                                     '根据城市的数量调整个数组的大小
  For i = 1 To MaxCities
    Input #1, a
    Input #1, City(i).x
    Input #1, City(i).y
  Next i                           '从文件中读出各城市的坐标
  Close #1
'''''''''''''''''为计算过程中绘制城市位置以及蚂蚁的路径作准备''''''''''''''''
'''''''''''''''''即，计算城市的x、y坐标的最大最小值''''''''''''''''''''''''''
  CityXMin = City(1).x: CityXMax = City(1).x
  CityYMin = City(1).y: CityYMax = City(1).y
  For i = 2 To MaxCities
    If City(i).x > CityXMax Then
      CityXMax = City(i).x
    Else
      If City(i).x < CityXMin Then
        CityXMin = City(i).x
      End If
    End If
    If City(i).y > CityYMax Then
      CityYMax = City(i).y
    Else
      If City(i).y < CityYMin Then
        CityYMin = City(i).y
      End If
    End If
  Next i
''''''''''''''''设置各条路径上的信息素浓度的初始值''''''''''''''''''''''''''''
  For i = 1 To MaxCities
    For j = 1 To MaxCities
      Tao(i, j) = Tao0
      NTao(i, j) = False   '这个数组用来表明每条路经商的信息素浓度是否改变
    Next j
  Next i
  For i = 1 To MaxAnts
    Ant(i).StartingCity = 1   '设置每只蚂蚁的起始城市为1号城市
    Ant(i).CurrentCity = 0    '这个变量用来表示蚂蚁当前所在的城市，这里先把它清零
    Ant(i).LengthOfPath = 0   '初始化蚂蚁的一次周游的路径长度为0
    For j = 1 To MaxCities
    ''''''''''''''设置每只蚂蚁的每一次选择的起始城市和目的城市为0''''''''''''''
      Ant(i).Tour(j).fromCity = 0
      Ant(i).Tour(j).toCity = 0
      Ant(i).Visited(j) = False     '设置蚂蚁已经访问过的城市的标志为“假”
    Next j
    Ant(i).Tour(1).fromCity = Ant(i).StartingCity  '设置蚂蚁的第一次选择的起始城市为蚂蚁周游的起始城市
  Next i
  For i = 1 To MaxCities
    For j = 1 To MaxCities
      Dis(i, j) = Sqr((City(i).x - City(j).x) ^ 2 + (City(i).y - City(j).y) ^ 2)  '计算每两个城市之间的距离
    Next j
  Next i
End Function

Public Sub Init_for_Avg_Calc()  '为计算平均值做准备
  For i = 1 To MaxCities
    For j = 1 To MaxCities
      Tao(i, j) = Tao0
      NTao(i, j) = False
    Next j
  Next i
  For i = 1 To MaxAnts
    Ant(i).StartingCity = 1
    Ant(i).CurrentCity = 0
    Ant(i).LengthOfPath = 0
    For j = 1 To MaxCities
        Ant(i).Tour(j).fromCity = 0
        Ant(i).Tour(j).toCity = 0
    Next j
    Ant(i).Visited(i) = False
    Ant(i).Tour(1).fromCity = Ant(i).StartingCity
  Next i

End Sub

Public Function Iteration_Init() As Integer
  For i = 1 To MaxAnts
    Ant(i).StartingCity = 1
    Ant(i).CurrentCity = 0
    Ant(i).LengthOfPath = 0
    For j = 1 To MaxCities
      Ant(i).Tour(j).fromCity = 0
      Ant(i).Tour(j).toCity = 0
      Ant(i).Visited(j) = False
    Next j
    Ant(i).Tour(1).fromCity = Ant(i).StartingCity
  Next i

End Function

Public Function SelectCity(ByVal n As Integer, ByVal NoTour As Integer) As Integer
  Dim STao As Double, P As Double, Sp As Double
  Dim STaoMax As Double, ArgSTaoMax As Integer
  Randomize Time
  P = Rnd
  If P <= Q0 Then
    STaoMax = 0
    j = Ant(n).CurrentCity
    For i = 1 To MaxCities
      If Ant(n).Visited(i) = False Then
        If STaoMax < Tao(j, i) Then
          STaoMax = Tao(j, i)
          ArgSTaoMax = i
        End If
      End If
    Next i
    SelectCity = ArgSTaoMax
    Exit Function
  End If
  STao = 0
  j = Ant(n).CurrentCity
  For i = 1 To MaxCities
    If Ant(n).Visited(i) = False Then
      STao = STao + (Tao(j, i) ^ Alpha) * ((1 / Dis(j, i)) ^ Beta)
    End If
  Next i
  If STao = 0 Then
    MsgBox "Error!Travel has been completed, but the ants are still running.STao=0"
    SelectCity = -1
    Exit Function
  End If
''''''Used to find the reason why this ant choose this path'''''''
'  Ant(n).Tour(NoTour).Prob = STao
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  Randomize Time
  P = Rnd * STao
  Sp = 0
  For i = 1 To MaxCities
    If Ant(n).Visited(i) = False Then
      Sp = Sp + (Tao(j, i) ^ Alpha) * ((1 / Dis(j, i)) ^ Beta)
      If Sp >= P Then
        SelectCity = i
        Ant(n).Tour(NoTour).Prob = ((Tao(j, i) ^ Alpha) * ((1 / Dis(j, i)) ^ Beta)) / STao
        Exit Function
      End If
    End If
  Next i
  MsgBox "Error!STao>Sp"
  SelectCity = -1
End Function

Public Function Local_Update(ByVal i As Integer, ByVal j As Integer)
  Tao(i, j) = (1 - Rou) * Tao(i, j) + Rou * Tao0
  Tao(j, i) = Tao(i, j)
End Function

Public Function PhUpdate(ByVal n As Integer) As Integer
  Dim aa As Double, bb As Double
  For i = 1 To MaxCities
    For j = 1 To MaxCities
      Tao(i, j) = (1 - Rou) * Tao(i, j)
      NTao(i, j) = False
      NTao(j, i) = False
      If Tao(i, j) > TaoMax Then
        Tao(i, j) = TaoMax
      Else
        If Tao(i, j) < TaoMin Then
          Tao(i, j) = TaoMin
        End If
      End If
      Tao(j, i) = Tao(i, j)
    Next j
  Next i
  For i = 1 To MaxCities
    aa = Ant(n).Tour(i).fromCity
    bb = Ant(n).Tour(i).toCity
    Tao(aa, bb) = Tao(aa, bb) + W / Ant(n).LengthOfPath
    NTao(aa, bb) = True
    NTao(bb, aa) = True
    If Tao(aa, bb) > TaoMax Then
      Tao(aa, bb) = TaoMax