Crossover Technique: Order Multiple
Order Multiple Crossover
This crossover is identical to the Order 1 Crossover, except multiple swaths are participants in the genetic exchange. |
VB.NET 2008 Source Code |
Public Sub OrderMultipleCrossover(ByRef Child As PChromo, ByRef Parent1 As PChromo, ByRef Parent2 As PChromo)
Dim counter1, counter2 As Integer
Dim CityTotal = AlleleCount - 1
Dim TempSeedPositionsMainC As New OrderMultipleCollection1
'Dim SeedPositionsMainC As New Collection
Dim AmountOfSwaths As Integer = 0.2 * CityTotal 'amount of swaths to create
Dim Swaths(AmountOfSwaths - 1) As Integer
Dim Done As Boolean = False
Dim TempSwathSize As Integer
Dim MaxSwathSize As Integer = AmountOfSwaths * 2.5 'max swath size
Dim SwathHashTable1 As New Hashtable
Dim P2Queue As New Queue
Dim SeedQueue As New Queue
'Determines where all the seeds start
For counter1 = 0 To AmountOfSwaths - 1
Swaths(counter1) = RAND.Next(0, CityTotal)
'If hashtable does not contain parent1.value then its ok to start another seed at this location
If (SwathHashTable1.ContainsKey(Parent1.Alleles(Swaths(counter1))) = False) Then
TempSwathSize = RAND.Next(1, MaxSwathSize)
SwathHashTable1.Add(Parent1.Alleles(Swaths(counter1)), Nothing)
TempSeedPositionsMainC = New OrderMultipleCollection1
TempSeedPositionsMainC.value = Parent1.Alleles(Swaths(counter1))
TempSeedPositionsMainC.swapsize = TempSwathSize
SeedQueue.Enqueue(TempSeedPositionsMainC)
Else
'Else, randomizer chose an already chosen location... so try for another
While (Done = False)
Swaths(counter1) = RAND.Next(0, CityTotal)
If (SwathHashTable1.ContainsKey(Parent1.Alleles(Swaths(counter1))) = False) Then
TempSwathSize = RAND.Next(1, MaxSwathSize)
SwathHashTable1.Add(Parent1.Alleles(Swaths(counter1)), Nothing)
TempSeedPositionsMainC = New OrderMultipleCollection1
TempSeedPositionsMainC.value = Parent1.Alleles(Swaths(counter1))
TempSeedPositionsMainC.swapsize = TempSwathSize
SeedQueue.Enqueue(TempSeedPositionsMainC)
Done = True
End If
End While
End If
Next
'grow the seeds
Dim XX As OrderMultipleCollection1
Done = False
While (Done = False)
XX = SeedQueue.Dequeue()
If (XX.complete = False) Then
For counter1 = 1 To MaxSwathSize
'if its trying to grow right, outside of citytotal... then grow left if false
If (XX.x - counter2 <= CityTotal) Then
If (SwathHashTable1.Contains(XX.x + counter1) = False And XX.rightmoves = True) Then
'if cant grow right anymore... then grow left
If (SwathHashTable1.ContainsKey(Parent1.Alleles(XX.x + counter1))) Then
XX.rightmoves = False
Else
'grow right 1
SwathHashTable1.Add(Parent1.Alleles(XX.x + counter1), Nothing)
End If
End If
'growing left... if can't grow left cause of < 0... then complete growing for this seed.
ElseIf ((XX.x - counter2 >= 0)) Then
If (SwathHashTable1.ContainsKey(Parent1.Alleles(XX.x - counter2)) And XX.leftmoves = True) Then
XX.rightmoves = False
'if can't move left anymore... then end loop
If (SwathHashTable1.ContainsKey(Parent1.Alleles(XX.x - counter2))) Then
XX.leftmoves = False
XX.complete = True
Else
'grow left 1
SwathHashTable1.Add(Parent1.Alleles(XX.x - counter2), Nothing)
counter2 += 1
End If
End If
Else
'seed is done growing
XX.rightmoves = False
XX.leftmoves = False
XX.complete = True
End If
Next
If (XX.swapsize = counter1) Then
'seed is done growing
XX.complete = True
XX.leftmoves = False
XX.rightmoves = False
End If
End If
If (SeedQueue.Count = 1) Then
Done = True
End If
End While
'move down parent 1 values
For counter1 = 0 To CityTotal
'this moves down parent 1 values to child
If (SwathHashTable1.Contains(Parent1.Alleles(counter1))) Then
Child.Alleles(counter1) = Parent1.Alleles(counter1)
Else
Child.Alleles(counter1) = -1
End If
'this sets which values of parent 2 to use
If (SwathHashTable1.ContainsKey(Parent2.Alleles(counter1)) = False) Then
P2Queue.Enqueue(Parent2.Alleles(counter1))
End If
Next
'moves parent 2 values down to child
For counter1 = 0 To CityTotal
If (Child.Alleles(counter1) = -1) Then
Child.Alleles(counter1) = P2Queue.Dequeue()
End If
Next
'Check for errors here... disable if no checking (comment out)
'OrderMultipleAndSingleChecker(Child, Parent1, Parent2, CityTotal, SwathHashTable1)
End Sub