modulemmas.bas

用VB写的蚁群算法实验软件

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 SignInitRan As Boolean
Public CityXMax As Double, CityXMin As Double, CityYMax As Double, CityYMin As Double

Public Function Init_MMAS()
  Dim TspFile As String
  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
  Input #1, MaxCities
  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
'''''''''''''Prepare for init PictureBoxes''''''''''''''''''''
  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
    If SignInitRan = True Then
      Ant(i).StartingCity = Int(Rnd * MaxCities) + 1
    Else
      Ant(i).StartingCity = 1
    End If
    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
  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 Function Iteration_Init() As Integer
  For i = 1 To MaxAnts
    If SignInitRan = True Then
      Ant(i).StartingCity = Int(Rnd * MaxCities) + 1
    Else
      Ant(i).StartingCity = 1
    End If
    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, 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
    Else
      If Tao(aa, bb) < TaoMin Then