Rubicite Genetic Algorithm Framework

Rubicite Genetic Algorith Framework Tutorial

General:

Crossovers:

Mutations:

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