www.pudn.com > acs_TSP_VB.rar > 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 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
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) < toamin 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
For i = 1 To MaxCities
For j = 1 To MaxCities
ColorTao = Int(((TaoMax - Tao(i, j)) / TaoMax) * 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