- Trọng số được đặt tại cỏc đỉ nh khụng đổi và bằng 1 Cú 8 giỏ trị media được chọ n (5, 15, 20, 25, 35, 45,
Cấu trỳc dữ liệu và cỏc module chương trỡnh
Cỏc cấu trỳc dữ liệu chớnh được xõy dựng bao gồm:
• Lớp CAnt mụ tả cỏc dữ liệu về mỗi con kiến và chu trỡnh di chuyển của chỳng. Type CAnt currentCity As Integer nextCity As Integer visitedCities() As Boolean path() As Integer pathIndex As Integer tourLength As Double End Type Trong đú: - currentCity lưu vị trớ hiện tại của con kiến
- nextCity lưu vị trớ tiếp theo mà con kiến sẽ chuyển đến
- visitedCity()đỏnh dấu cỏc điểm mà con kiến đó đi qua
- path() lưu đường dẫn qua cỏc đỉnh mà con kiến đó đi qua
- pathIndex lưu vị trớ hiện tại trong đường dẫn.
- tourLenght lưu độ dài hành trỡnh mà con kiến đó đi quạ
• Lớp CSolution mụ tả cỏc dữ liệu về tập cỏc lời giải khả thị Type CSolution Medians() As Integer Index As Double bestCost As Double bestIndex As Double
82
End Type Trong đú:
- Medians() là tập cỏc median khả thi, mỗi median là một bộ gồm k_median điểm.
- Index lưu số lượng trong vịđó duyệt cho đến thời điểm hiện tạị
- bestCost lưu giỏ trị chi phớ tốt nhất tớnh đến thời điểm hiện tạị
- bestIndex lưu trữ vị trớ median đạt giỏ trị tốt nhất đú.
Cỏc module chương trỡnh chủ yếu bao gồm:
‘ Thủ tục xỏc định hàm đỏnh giỏ xỏc suất
Function AntProduct(from As Integer, t_o As Integer) As Double
AntProduct = ((pow(pheromone(from, t_o), ALPHA) * pow((1 / distance(from, t_o)), BETA)))
End Function
'Thủ tục tớnh toỏn điểm tiếp theo mà con kiến thứ ant sẽ chuyển tới
Function GetNextCity(ant As Integer) As Integer Dim denom As Double
Dim p As Double Dim q As Double Dim Pos As Integer Dim stamp As Integer denom = 0
from = Ants(ant).currentCity For t_o = 0 To MAX_CITIES
If (Ants(ant).visitedCities(t_o) = 0) Then denom = denom + AntProduct(from, t_o) End If
Next stamp = 0
83
If (Ants(ant).visitedCities(t_o) = 0) Then stamp = stamp + 1 Next If stamp = 0 Then GetNextCity = -1 Exit Function End If Do While (1) t_o = t_o + 1
If (t_o > MAX_CITIES) Then t_o = 0 If (Ants(ant).visitedCities(t_o) = 0) Then p = AntProduct(from, t_o) / denom If (Threshold < p) Then Exit Do End If
Loop
GetNextCity = t_o
End Function
'Thủ tục tớnh toỏn điểm sẽ thay thế trong tập lời giải khả thi
Function ChangeWorstCity(ant As Integer, NewCity As Integer) As Integer Dim OldCity As Integer
Dim best As Double Dim city As Integer Dim index As Integer Dim from As Integer Dim Temp As Double best = MAX_DOUBLE OldCity = -1
For from = 0 To k_MEDIAN city = Ants(ant).Solution(from) Ants(ant).Solution(from) = NewCity Temp = Cost(ant)
If best > Temp Then best = Temp OldCity = city index = from End If Ants(ant).Solution(from) = city Next Ants(ant).Solution(index) = NewCity ChangeWorstCity = OldCity End Function
84
'Thủ tục tớnh toỏn tập lời giải khởi tạo cho đàn kiến
Public Function InitializeSolution() As Integer Dim moving As Integer
moving = 0
For ant = 0 To MAX_ANTS With Ants(ant)
If .pathIndex < MAX_CITIES) Then .nextCity = GetNextCity(ant) If .nextCity = -1 Then Exit Function .visitedCities(.nextCity) = 1
.path(.pathIndex + 1) = .nextCity
If .pathIndex < k_MEDIAN) Then .Solution(.pathIndex + 1) = .nextCity End If
.pathIndex = .pathIndex + 1
.tourLength = .tourLength + distance(.currentCity, .nextCity) If (.pathIndex = MAX_CITIES) Then
.tourLength = .tourLength + distance(.path(MAX_CITIES - 1),.path(0)) End If .currentCity = .nextCity moving = moving + 1 End If End with Next InitializeSolution = moving End Function
'Thủ tục tớnh toỏn lời giải tiếp theo cho đàn kiến
Public Function SimulateAnts() As Integer Dim moving As Integer
Dim city As Integer moving = 0
For ant = 0 To MAX_ANTS With Ants(ant)
If moving < MAX_CITIES Then .nextCity = GetNextCity(ant) If .nextCity = -1 Then
moving = -1 Exit For End If
city = ChangeWorstCity(ant, .nextCity) If city = -1 Then
85 Exit For Exit For End If .visitedCities(.nextCity) = 1 .path(.pathIndex + 1) = .nextCity .pathIndex = .pathIndex + 1
.tourLength = .tourLength + distance(.currentCity, .nextCity) .currentCity = .nextCity moving = moving + 1 Else moving = -1 Exit For End If End with Next SimulateAnts = moving End Function 'Thủ tục cập nhật vệt của đàn kiến
Public Sub UpdateTrails()
Dim from, t_o, i, ant As Integer ' _pheromone Evaporation For from = 0 To MAX_CITIES For t_o = 0 To MAX_CITIES If (from <> t_o) Then
pheromone(from, t_o) = pheromone(from, t_o) * (1 - RHO) If (pheromone(from, t_o) < 0) Then pheromone(from, t_o) = 0 End If
Next Next
For ant = 0 To MAX_ANTS For i = 0 To MAX_CITIES If (i < MAX_CITIES - 1) Then from = Ants(ant).path(i) t_o = Ants(ant).path(i + 1) Else from = Ants(ant).path(i) t_o = Ants(ant).path(0) End If
If (from >= 0) And (t_o >= 0) Then
pheromone(from, t_o) = pheromone(from, t_o) + (QVAL / Ants(ant).tourLength)
pheromone(t_o, from) = pheromone(from, t_o) End If
86
Next
For from = 0 To MAX_CITIES For t_o = 0 To MAX_CITIES
pheromone(from, t_o) = pheromone(from, t_o) * RHO Next
Next
End Sub
'Thủ tục tớnh toỏn chi phớ đạt được lời giải của con kiến thứ ant
Public Function Cost(ant As Integer) As Double Dim disTemp As Double
Dim Temp As Double Dim CalCost As Double CalCost = 0
For from = 0 To MAX_CITIES disTemp = MAX_DOUBLE For t_o = 0 To k_MEDIAN With Ants(ant)
If distance(from, .Solution(t_o)) = 0 Then disTemp = 0
Exit For
ElseIf disTemp > distance(from,.Solution(t_o)) Then ' disTemp = distance(from, .Solution(t_o))
End If Next
CalCost = CalCost + disTemp Next
Cost = CalCost
End Function
'Thủ tục chớnh của thuật toỏn
Public Sub ACO_Algorithm()
For i = 0 To 10000
If SimulateAnts = -1 Then MsgBox "Finish search!" Exit Sub
End If
UpdateTrails
For ant = 0 To MAX_ANTS
If bestPossible > Cost(ant) Then bestPossible = Cost(ant) bestAntPosition = ant End If
87
ShowResult DoEvents Next