Rubicite Genetic Algorithm Framework

Rubicite Genetic Algorith Framework Tutorial

General:

Crossovers:

Mutations:

Mutation Technique: Random Slide

VB.NET 2008 Source Code

'Default Float 0 is "0.01" and represents Minimum Swath Size. Valid Values are [0, 0.75] 'Default Float 0 is "0.5" and represents Maximum Swath Size. Valid Values are [0, 0.75] Sub RandomSlide_Mutation(ByRef Child1 As PChromo) Dim MinSwathSizePercent As Double = RandomSlide_Master.Doubles(0) Dim MaxSwatchSizePercent As Double = RandomSlide_Master.Doubles(1) '1. Determine Start and Stop of Swath || Also determine direction of slide Dim SlideRight As Boolean = RAND.Next(0, 2) Dim SwathSize As Integer = RAND.Next(RandomSlide_Master.Doubles(0) * AlleleCount, RandomSlide_Master.Doubles(1) * AlleleCount) 'Doubles(0) = Min Swath Size || Doubles(1) = Max Swath Size Dim X, Y As Integer 'X refers to left most value of swatch, Y refers to index of right most value in swath If SlideRight Then 'if we're sliding right, we need some room to slide to the right Y = RAND.Next(SwathSize, AlleleCount - 2) '-2 results in at least 1 spot to slide to the right X = Y - SwathSize + 1 Else 'if we're sliding left, we need some room to slide to the left X = RAND.Next(1, AlleleCount - SwathSize) Y = X + SwathSize - 1 End If '2 Determine the length of the slide Dim SlideLength As Integer If SlideRight Then SlideLength = RAND.Next(1, AlleleCount - Y) Else SlideLength = RAND.Next(1, X + 1) End If '3 Calculate new X & Y locations after slide Dim NewX, NewY As Integer If SlideRight Then NewX = X + SlideLength NewY = Y + SlideLength Else NewX = X - SlideLength NewY = Y - SlideLength End If '4. Initialize Flags() - True means that value is a part of the swath. False means it isn't. ' This will help us fill in values correctly Dim Flags(AlleleCount) As Boolean For j As Integer = 0 To AlleleCount - 1 If j >= X And j <= Y Then Flags(j) = True Else Flags(j) = False End If Next '5a. Fill up NewChild up to NewX (If the slide is to the left) ' Nothing changes between the old and new child up to the index before NewX '5b. Fill up NewChild starting from the right down to the index before NewY (if slide is to the right) ' Nothing changes between the old and new child down to the index after NewY Dim NewChild As New PChromo ReDim NewChild.Alleles(AlleleCount) If SlideRight Then For j As Integer = AlleleCount - 1 To NewY + 1 Step -1 NewChild.Alleles(j) = Child1.Alleles(j) Next Else For j As Integer = 0 To NewX - 1 NewChild.Alleles(j) = Child1.Alleles(j) Next End If '6. Now, add in swath values. ' Remember, if we're sliding right, we're filling in from the right side Dim marker, iTemp As Integer If SlideRight Then marker = NewY 'this variable tracks the point to insert the next value in the new child iTemp = Y 'used for copying over swath For j As Integer = NewY To NewX Step -1 NewChild.Alleles(marker) = Child1.Alleles(iTemp) marker -= 1 iTemp -= 1 Next Else marker = NewX 'this variable tracks the point to insert the next value in the newchild iTemp = X 'used for copying over swath For j As Integer = NewX To NewY NewChild.Alleles(marker) = Child1.Alleles(iTemp) marker += 1 iTemp += 1 Next End If '7. Now, go back and insert all the ones not selected for insertion ' remember, marker marks where we're at in regards to filling up the new child ' Also, if flags(x) is true, then its value in child1 is a swath value If SlideRight Then For j As Integer = NewY To 0 Step -1 If Not Flags(j) Then NewChild.Alleles(marker) = Child1.Alleles(j) marker -= 1 End If Next Else For j As Integer = NewX To AlleleCount - 1 If Not Flags(j) Then NewChild.Alleles(marker) = Child1.Alleles(j) marker += 1 End If Next End If 'Copy over new kid Child1.setTo(NewChild) End Sub