modulemmas.bas

蚂蚁算法实验室

    Else
      If Tao(aa, bb) < TaoMin Then
        Tao(aa, bb) = TaoMin
      End If
    End If
    Tao(bb, aa) = Tao(aa, bb)
  Next i
  PhUpdate = 1
End Function

'Public Function PhUpdate1(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)
'      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) - Sigma * W / Ant(n).LengthOfPath
'    If Tao(aa, bb) > TaoMax Then
'      Tao(aa, bb) = TaoMax
'    Else
'      If Tao(aa, bb) < TaoMin Then
'        Tao(aa, bb) = TaoMin
'      End If
'    End If
'    Tao(bb, aa) = Tao(aa, bb)
'  Next i
'  PhUpdate1 = 1

'End Function
Public Function PhUpdate1(ByVal i As Integer, ByVal j As Integer, ByVal k As Double, l As Double) As Integer
  Tao(i, j) = (1 - Rou) * Tao(i, j) - Sigma * W * k / l
  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)
  PhUpdate1 = 1
End Function
Public Function CalcLen(ByVal n As Integer) As Double
  Dim aa As Integer, bb As Integer, cc As Double
  For i = 1 To MaxCities
    aa = Ant(n).Tour(i).fromCity
    bb = Ant(n).Tour(i).toCity
    cc = cc + Dis(aa, bb)
  Next i
  CalcLen = cc
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''The following code is for outputing of the result'''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub Draw_XOY()
  Dim StepX As Double, StepY As Double
  frmMMAS.AxisBestLenX.ScaleX (Val(frmMMAS.txtBestLenXMax.Text) - Val(frmMMAS.txtBestLenXMin.Text))
  frmMMAS.AxisBestLenY.ScaleY (Val(frmMMAS.txtBestLenYMax.Text) - Val(frmMMAS.txtBestLenYMin.Text))
  If Val(frmMMAS.txtBestLenNX.Text) > 0 And Val(frmMMAS.txtBestLenNY.Text) > 0 Then
    StepX = frmMMAS.AxisBestLenX.Width / Val(frmMMAS.txtBestLenNX.Text)
    StepY = frmMMAS.AxisBestLenY.Height / Val(frmMMAS.txtBestLenNY.Text)
    For i = 1 To Val(frmMMAS.txtBestLenNX.Text) - 1
      frmMMAS.AxisBestLenX.Line (StepX * i, 0)-(StepX * i, frmMMAS.AxisBestLenX.Height)
    Next i
    For i = 1 To Val(frmMMAS.txtBestLenNY.Text) - 1
      frmMMAS.AxisBestLenY.Line (0, StepY * i)-(frmMMAS.AxisBestLenY.Width, StepY * i)
    Next i
  End If
  frmMMAS.AxisAvgLenX.ScaleX (Val(frmMMAS.txtAvgLenXMax.Text) - Val(frmMMAS.txtAvgLenXMin.Text))
  frmMMAS.AxisAvgLenY.ScaleY (Val(frmMMAS.txtAvgLenYMax.Text) - Val(frmMMAS.txtAvgLenYMin.Text))
  If Val(frmMMAS.txtAvgLenNX.Text) > 0 And Val(frmMMAS.txtAvgLenNY.Text) > 0 Then
    StepX = frmMMAS.AxisAvgLenX.Width / Val(frmMMAS.txtAvgLenNX.Text)
    StepY = frmMMAS.AxisAvgLenY.Height / Val(frmMMAS.txtAvgLenNY.Text)
    For i = 1 To Val(frmMMAS.txtAvgLenNX.Text) - 1
      frmMMAS.AxisAvgLenX.Line (StepX * i, 0)-(StepX * i, frmMMAS.AxisAvgLenX.Height)
    Next i
    For i = 1 To Val(frmMMAS.txtAvgLenNY.Text) - 1
      frmMMAS.AxisAvgLenY.Line (0, StepY * i)-(frmMMAS.AxisAvgLenY.Width, StepY * i)
    Next i
  End If
  
End Sub

Public Sub Draw_Best_Graph(ByVal i As Integer, ByVal k As Double)
'i  Iteration;k  LBest
  If i = 1 Then
    frmMMAS.picBestLen.PSet (i, k)
  Else
    frmMMAS.picBestLen.Line -(i, k)
  End If
End Sub
Public Sub Draw_Avg_Graph(ByVal i As Integer, ByVal k As Double, ByVal DrawTogether As Boolean)
  If DrawTogether = False Then
    If i = 1 Then
      frmMMAS.picAvgLen.PSet (i, k)
    Else
      frmMMAS.picAvgLen.Line -(i, k)
    End If
  Else
  End If
End Sub

Public Sub Init_Pic()
  frmMMAS.picBestLen.ScaleTop = Val(frmMMAS.txtBestLenYMax.Text)
  frmMMAS.picBestLen.ScaleHeight = (Val(frmMMAS.txtBestLenYMin.Text) - Val(frmMMAS.txtBestLenYMax.Text))
  frmMMAS.picBestLen.ScaleLeft = Val(frmMMAS.txtBestLenXMin.Text)
  frmMMAS.picBestLen.ScaleWidth = Val(frmMMAS.txtBestLenXMax.Text) - Val(frmMMAS.txtBestLenXMin.Text)
  frmMMAS.picAvgLen.ScaleTop = Val(frmMMAS.txtAvgLenYMax.Text)
  frmMMAS.picAvgLen.ScaleHeight = Val(frmMMAS.txtAvgLenYMin.Text) - Val(frmMMAS.txtAvgLenYMax.Text)
  frmMMAS.picAvgLen.ScaleLeft = Val(frmMMAS.txtAvgLenXMin.Text)
  frmMMAS.picAvgLen.ScaleWidth = Val(frmMMAS.txtAvgLenXMax.Text) - Val(frmMMAS.txtAvgLenXMin.Text)
End Sub
Public Sub Draw_City_Init()
  If CityXMax - CityXMin > CityYMax - CityYMin Then
    frmMMAS.picCityMap.ScaleLeft = CityXMin - 5
    frmMMAS.picCityMap.ScaleWidth = CityXMax - CityXMin + 10
    frmMMAS.picCityMap.ScaleTop = frmMMAS.picCityMap.ScaleLeft
    frmMMAS.picCityMap.ScaleHeight = frmMMAS.picCityMap.ScaleWidth
  Else
    frmMMAS.picCityMap.ScaleLeft = CityYMin - 5
    frmMMAS.picCityMap.ScaleWidth = CityYMax - CityYMin + 10
    frmMMAS.picCityMap.ScaleTop = frmMMAS.picCityMap.ScaleLeft
    frmMMAS.picCityMap.ScaleHeight = frmMMAS.picCityMap.ScaleWidth
  End If
End Sub
Public Sub Draw_City()
  Dim Ra As Double
  frmMMAS.picCityMap.Cls
  Ra = frmMMAS.picCityMap.ScaleHeight / 200
  For i = 1 To MaxCities
    frmMMAS.picCityMap.Circle (City(i).x, City(i).y), Ra, vbRed
  Next i
End Sub

Public Sub Draw_Path(ByVal n As Integer)
  Dim Ra As Double
  frmMMAS.picCityMap.Cls
  Ra = frmMMAS.picCityMap.ScaleHeight / 200
  For i = 1 To MaxCities
    frmMMAS.picCityMap.Circle (City(i).x, City(i).y), Ra, vbRed
    frmMMAS.picCityMap.Line (City(Int(Ant(n).Tour(i).fromCity)).x, City(Int(Ant(n).Tour(i).fromCity)).y)-(City(Int(Ant(n).Tour(i).toCity)).x, City(Int(Ant(n).Tour(i).toCity)).y), vbRed
  Next i
End Sub
Public Sub Draw_Tao_Init()
  If CityXMax - CityXMin > CityYMax - CityYMin Then
    frmMMAS.picTao.ScaleLeft = CityXMin - 5
    frmMMAS.picTao.ScaleWidth = CityXMax - CityXMin + 10
    frmMMAS.picTao.ScaleTop = frmMMAS.picTao.ScaleLeft
    frmMMAS.picTao.ScaleHeight = frmMMAS.picTao.ScaleWidth
  Else
    frmMMAS.picTao.ScaleLeft = CityYMin - 5
    frmMMAS.picTao.ScaleWidth = CityYMax - CityYMin + 10
    frmMMAS.picTao.ScaleTop = frmMMAS.picTao.ScaleLeft
    frmMMAS.picTao.ScaleHeight = frmMMAS.picTao.ScaleWidth
  End If

End Sub
Public Sub Draw_Tao()
  Dim ColorTao As Byte
  Dim Ra As Double
  Ra = frmMMAS.picCityMap.ScaleHeight / 200
  frmMMAS.picTao.Cls
  TaoMaxInIter = 0
  For i = 1 To MaxCities
    For j = 1 To MaxCities
      If TaoMaxInIter < Tao(i, j) Then
        TaoMaxInIter = Tao(i, j)
      End If
    Next j
  Next i
  frmMMAS.txtMaxTaoInIter.Text = TaoMaxInIter
  For i = 1 To MaxCities
    For j = 1 To MaxCities
      ColorTao = Int(((TaoMaxInIter - Tao(i, j)) / TaoMaxInIter) * 255)
      frmMMAS.picTao.Line (City(i).x, City(i).y)-(City(j).x, City(j).y), RGB(ColorTao, ColorTao, ColorTao)
    Next j
  Next i
  For i = 1 To MaxCities
    frmMMAS.picTao.Circle (City(i).x, City(i).y), Ra, vbRed
  Next i
End Sub
Public Sub Show_Ant_Move_Init()
  If CityXMax - CityXMin > CityYMax - CityYMin Then
    frmMMAS.picMovOfAnt.ScaleLeft = CityXMin - 5
    frmMMAS.picMovOfAnt.ScaleWidth = CityXMax - CityXMin + 10
    frmMMAS.picMovOfAnt.ScaleTop = frmMMAS.picMovOfAnt.ScaleLeft
    frmMMAS.picMovOfAnt.ScaleHeight = frmMMAS.picMovOfAnt.ScaleWidth
  Else
    frmMMAS.picMovOfAnt.ScaleLeft = CityYMin - 5
    frmMMAS.picMovOfAnt.ScaleWidth = CityYMax - CityYMin + 10
    frmMMAS.picMovOfAnt.ScaleTop = frmMMAS.picMovOfAnt.ScaleLeft
    frmMMAS.picMovOfAnt.ScaleHeight = frmMMAS.picMovOfAnt.ScaleWidth
  End If
End Sub
Public Sub Show_Ant_Move(ByVal n As Integer)
  Dim ColorTao As Byte
  Dim Ra As Double, Ra1 As Double
  Ra = frmMMAS.picMovOfAnt.ScaleHeight / 200
  Ra1 = frmMMAS.picMovOfAnt.ScaleHeight / 150
  frmMMAS.picMovOfAnt.Cls
  For i = 1 To MaxCities
    For j = 1 To MaxCities
      ColorTao = Int(((TaoMax - Tao(i, j)) / TaoMax) * 255)
      frmMMAS.picMovOfAnt.Line (City(i).x, City(i).y)-(City(j).x, City(j).y), RGB(ColorTao, ColorTao, ColorTao)
    Next j
  Next i
  For i = 1 To MaxCities
    frmMMAS.picMovOfAnt.Circle (City(i).x, City(i).y), Ra, vbRed
  Next i
  c1 = Int(Ant(n).Tour(1).fromCity)
  frmMMAS.picMovOfAnt.Circle (City(c1).x, City(c1).y), Ra1, vbBlue
  For i = 1 To MaxCities
    SignShowNextMove = False
    frmMMAS.cmdNextMove.Enabled = True
    frmMMAS.cmdNextMove.Enabled = True
    c1 = Int(Ant(n).Tour(i).fromCity)
    c2 = Int(Ant(n).Tour(i).toCity)
    frmMMAS.picMovOfAnt.Circle (City(c2).x, City(c2).y), Ra1, vbBlue
    frmMMAS.picMovOfAnt.Line (City(c1).x, City(c1).y)-(City(c2).x, City(c2).y)
    frmMMAS.txtProb.Text = Ant(n).Tour(i).Prob
    Do
      For j = 1 To 10000
        DoEvents
      Next j
      frmMMAS.picMovOfAnt.Circle (City(c2).x, City(c2).y), Ra1, vbWhite
      For j = 1 To 10000
        DoEvents
      Next j
      frmMMAS.picMovOfAnt.Circle (City(c2).x, City(c2).y), Ra1, vbBlue
    Loop Until SignShowNextMove = True
  Next i
End Sub