Public Class Population
Public Tours As List(Of Tour)
Private popSize, selCount, mutChance As Integer
Public Sub New()
Me.Tours = New List(Of Tour)
popSize = My.Settings.PopulationSize
selCount = My.Settings.SelectionCount
mutChance = My.Settings.MutationChance
End Sub
Public Sub New(ByVal tours As List(Of Tour))
Me.Tours = tours
popSize = My.Settings.PopulationSize
selCount = My.Settings.SelectionCount
mutChance = My.Settings.MutationChance
End Sub
Public Sub Initialize(ByVal cities As CityCollection)
Dim t As Tour
For i As Integer = 0 To popSize - 1
t = New Tour(cities)
t.Initialize()
Me.Tours.Add(t)
Next
End Sub
Public Sub RunGeneration()
' Selection:
Dim fittest As List(Of Tour) = GetFittest()
' Recombination:
Dim children As New List(Of Tour)
For i As Integer = 0 To fittest.Count - 1 Step 2
If i = fittest.Count - 1 Then
'we have a spare, just add it
children.Add(fittest(i))
Else
children.Add(CrossOver(fittest(i), fittest(i + 1)))
End If
Next
' Dismiss the worst tours so we can add the new children and keep the population size constant
Dim toursToKeep As Integer = popSize - children.Count
Me.Tours = (From t As Tour In Me.Tours _
Order By t.Fitness Descending _
Select t).Take(toursToKeep).ToList()
Me.Tours.AddRange(children)
' Mutation
Mutate()
End Sub
Public Function GetFittest() As List(Of Tour)
Dim shortestLength As Double = (From t As Tour In Me.Tours _
Select t.Length).Min
For Each t As Tour In Me.Tours
t.Fitness = shortestLength / t.Length
Next
Return (From t As Tour In Me.Tours _
Order By t.Fitness Descending _
Select t).Take(selCount).ToList()
End Function
Public Function CrossOver(ByVal parent1 As Tour, ByVal parent2 As Tour) As Tour
Dim c1, c2 As City
Dim newCities As New CityCollection
newCities.Add(parent1.Cities(0))
For i As Integer = 1 To parent1.Cities.Count - 1
c1 = parent1.Cities(i)
c2 = parent2.Cities(i)
If newCities.ContainsNumber(c1.Number) Then
If newCities.ContainsNumber(c2.Number) Then
' Both c1 and c2 are present, add random other
' Take a random city from the union of the cities of both parents
' that is not already present in the current list of cities
Dim newCity As City = (From c As City In parent1.Cities.Union(parent2.Cities) _
Where Not newCities.ContainsNumber(c.Number) _
Order By RNG.Random.NextDouble _
Select c).First()
newCities.Add(newCity)
Else
'Only c1 is present, add c2
newCities.Add(c2)
End If
Else
If newCities.ContainsNumber(c2.Number) Then
'Only c2 is present, add c1
newCities.Add(c1)
Else
'Both are not present, add shortest
Dim distance1 As Double = Tour.Distance(newCities(i - 1), c1)
Dim distance2 As Double = Tour.Distance(newCities(i - 1), c2)
If distance1 < distance2 Then
newCities.Add(c1)
Else
newCities.Add(c2)
End If
End If
End If
Next
Return New Tour(newCities)
End Function
Public Sub Mutate()
For Each t As Tour In Me.Tours
If RNG.Random.Next(0, 101) <= mutChance Then
t.Cities.RandomSwap()
End If
Next
End Sub
End Class
