Attribute VB_Name = "NeoMutations" Option Explicit Private Type MutationsType PointPerUnit As Long 'per kilocycle PointCycle As Long 'the cycle we are goin to point mutate during PointMean As Single 'average length of DNA to change PointStdDev As Single 'std dev of this length ReproduceTotalPerUnit As Long Reproduce As Long 'a 1 in X chance to mutate when we reproduce ReversalPerUnit As Long ReversalLengthMean As Single ReversalLengthStdDev As Single CopyErrorPerUnit As Long InsertionPerUnit As Long AmplificationPerUnit As Long MajorDeletionPerUnit As Long MinorDeletionPerUnit As Long End Type Dim timee As Double '1-(perbot+1)^(1/DNALength) = per unit '1-(1-perunit)^DNALength = perbot Public Const PointUP As Integer = 0 'expressed as 1 chance in X per kilocycle per bp Public Const MinorDeletionUP As Integer = 1 Public Const ReversalUP As Integer = 2 Public Const InsertionUP As Integer = 3 Public Const AmplificationUP As Integer = 4 Public Const MajorDeletionUP As Integer = 5 Public Const CopyErrorUP As Integer = 6 Public Const DeltaUP As Integer = 7 Public Const TranslocationUP As Integer = 8 Private Function MutationType(thing As Integer) As String MutationType = "" Select Case thing Case 0 MutationType = "Point Mutation" Case 1 MutationType = "Minor Deletion" Case 2 MutationType = "Reversal" Case 3 MutationType = "Insertion" Case 4 MutationType = "Amplification" Case 5 MutationType = "Major Deletion" Case 6 MutationType = "Copy Error" Case 7 MutationType = "Delta Mutation" End Select End Function 'NEVER allow anything after end, which must be = DNALen 'ALWAYS assume that DNA is sized right 'ALWAYS size DNA correctly when mutating Private Function EraseUnit(ByRef unit As block) unit.tipo = -1 unit.value = -1 End Function Public Function MakeSpace(ByRef DNA() As block, ByVal beginning As Long, ByVal length As Long, Optional DNALength As Integer = -1) As Boolean 'add length elements after beginning. Beginning doesn't move places 'returns true if the space was created, 'false otherwise Dim t As Integer If DNALength < 0 Then DNALength = UBound(DNA) 'botschange If length < 1 Or beginning < 0 Or beginning > DNALength - 1 Or (DNALength + length > 32000) Then MakeSpace = False GoTo getout End If MakeSpace = True ReDim Preserve DNA(DNALength + length) For t = DNALength To beginning + 1 Step -1 If Timer - 4 > timee Then Exit Function 'safe DNA(t + length) = DNA(t) EraseUnit DNA(t) Next t getout: End Function Public Sub Delete(ByRef DNA() As block, ByRef beginning As Long, ByRef elements As Long, Optional DNALength As Integer = -1) On Error GoTo getout: 'delete elements starting at beginning Dim t As Integer If DNALength < 0 Then DNALength = UBound(DNA) 'botschange If elements < 1 Or beginning < 1 Or beginning > DNALength - 1 Then GoTo getout ' If elements + beginning > DNALength - 1 Then elements = DNALength - 1 - beginning For t = beginning + elements To DNALength If Timer - 4 > timee Then Exit Sub 'safe DNA(t - elements) = DNA(t) Next t DNALength = DnaLen(DNA) ReDim Preserve DNA(DNALength) getout: End Sub Public Function NewSubSpecies(n As Integer) As Integer Dim i As Integer i = SpeciesFromBot(n) ' Get the index into the species array for this bot SimOpts.Specie(i).SubSpeciesCounter = SimOpts.Specie(i).SubSpeciesCounter + 1 ' increment the counter If SimOpts.Specie(i).SubSpeciesCounter > 32000 Then SimOpts.Specie(i).SubSpeciesCounter = -32000 'wrap the counter if necessary NewSubSpecies = SimOpts.Specie(i).SubSpeciesCounter End Function ''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Public Sub Mutate(robn As Integer, Optional reproducing As Boolean = False) Dim delta As Long timee = Timer With rob(robn) If Not .Mutables.Mutations Or SimOpts.DisableMutations Then GoTo getout delta = CLng(.LastMut) 'botschange no Delta If .Mutables.mutarray(PointUP) > 0 Then PointMutation robn '! 'If .Mutables.mutarray(DeltaUP) > 0 Then DeltaMut robn '! If .Mutables.mutarray(CopyErrorUP) > 0 Then CopyError robn '! If .Mutables.mutarray(InsertionUP) > 0 Then Insertion robn '! If .Mutables.mutarray(ReversalUP) > 0 Then Reversal robn '! If .Mutables.mutarray(TranslocationUP) > 0 Then Translocation robn '! If .Mutables.mutarray(AmplificationUP) > 0 Then Amplification robn '! If .Mutables.mutarray(MajorDeletionUP) > 0 Then MajorDeletion robn '! If .Mutables.mutarray(MinorDeletionUP) > 0 Then MinorDeletion robn '! delta = CLng(.LastMut) - delta If (delta > 0) Then 'The bot has mutated. mutatecolors robn, delta .SubSpecies = NewSubSpecies(robn) .genenum = CountGenes(rob(robn).DNA()) .DnaLen = DnaLen(rob(robn).DNA()) .mem(DnaLenSys) = .DnaLen .mem(GenesSys) = .genenum End If getout: End With End Sub Private Sub PointMutation(robn As Integer) 'botschange full redo of point mutation Dim dnaSize As Integer Dim e As Integer 'counter Dim e2 As Integer 'update generator Dim randomsysvar As Integer With rob(robn) dnaSize = DnaLen(.DNA) - 1 'get aprox length Dim datahit() As Boolean 'operation repeat prevention ReDim datahit(dnaSize) For e = 0 To dnaSize If Rnd < (1 / (.Mutables.mutarray(PointUP) * 28 / 300)) Then 'chance Do e2 = Int(Rnd * (dnaSize + 1)) Loop Until datahit(e2) = False datahit(e2) = True Do randomsysvar = Int(Rnd * 1000) Loop Until sysvar(randomsysvar).Name <> "" .DNA(e2).tipo = 1 If .DNA(e2 + 1).tipo = 7 Then .DNA(e2).tipo = 0 'if store , inc , or dec then type 0 ' If .DNA(e2 + 1).tipo = 7 Then ' MsgBox sysvar(randomsysvar).Name ' robfocus = robn ' End If .DNA(e2).value = sysvar(randomsysvar).value 'impotent: transfears value, not adress .LastMutDetail = "Point mutation changed dna location " & e2 & " to: " & sysvar(randomsysvar).Name & vbCrLf & .LastMutDetail .Mutations = .Mutations + 1 .LastMut = .LastMut + 1 End If Next End With End Sub Private Sub PointMutWhereAndWhen(randval As Single, robn As Integer, Optional offset As Long = 0) Dim result As Single 'If randval = 0 Then randval = 0.0001 With rob(robn) If .DnaLen = 1 Then GoTo getout ' avoid divide by 0 below 'Here we test to make sure the probability of a point mutation isn't crazy high. 'A value of 1 is the probability of mutating every base pair every 1000 cycles 'Lets not let it get lower than 1 shall we? If .Mutables.mutarray(PointUP) < 1# And .Mutables.mutarray(PointUP) <> 0 Then .Mutables.mutarray(PointUP) = 1# End If 'result = offset + Fix(Log(randval) / Log(1 - 1 / (1000 * .Mutables.mutarray(PointUP)))) result = Log(1 - randval) / Log(1 - 1 / (1000 * .Mutables.mutarray(PointUP))) .PointMutBP = (result Mod (.DnaLen - 1)) + 1 'note that DNA(DNALen) = end. 'We don't mutate end. Also note that DNA does NOT start at 0th element .PointMutCycle = .age + result / (.DnaLen - 1) getout: End With End Sub Private Sub DeltaMut(robn As Integer) Dim temp As Integer Dim newval As Single ' EricL Made newval Single instead of Long. With rob(robn) If Rnd > 1 - 1 / (100 * .Mutables.mutarray(DeltaUP)) Then If .Mutables.StdDev(DeltaUP) = 0 Then .Mutables.Mean(DeltaUP) = 50 If .Mutables.Mean(DeltaUP) = 0 Then .Mutables.Mean(DeltaUP) = 25 'temp = Random(0, 20) Do If Timer - 4 > timee Then Exit Sub 'safe temp = Random(0, 7) Loop While .Mutables.mutarray(temp) <= 0 Do If Timer - 4 > timee Then Exit Sub 'safe newval = Gauss(.Mutables.Mean(DeltaUP), .Mutables.mutarray(temp)) Loop While .Mutables.mutarray(temp) = newval Or newval <= 0 .LastMutDetail = "Delta mutations changed " + MutationType(temp) + " from 1 in" + Str(.Mutables.mutarray(temp)) + _ " to 1 in" + Str(newval) + vbCrLf + .LastMutDetail .Mutations = .Mutations + 1 .LastMut = .LastMut + 1 .Mutables.mutarray(temp) = newval End If End With End Sub Private Sub CopyError(robn As Integer) Dim t As Long Dim accum As Long Dim length As Long With rob(robn) For t = 1 To (.DnaLen - 1) 'note that DNA(.dnalen) = end, and we DON'T mutate that. If Timer - 4 > timee Then Exit Sub 'safe If Rnd < 1 / rob(robn).Mutables.mutarray(CopyErrorUP) Then length = Gauss(rob(robn).Mutables.StdDev(CopyErrorUP), _ rob(robn).Mutables.Mean(CopyErrorUP)) 'length accum = accum + length ChangeDNA robn, t, length, rob(robn).Mutables.CopyErrorWhatToChange, _ CopyErrorUP End If Next t End With End Sub 'Private Sub ChangeDNA(ByRef DNA() As block, nth As Long, Optional length As Long = 1) Private Sub ChangeDNA(robn As Integer, ByVal nth As Long, Optional ByVal length As Long = 1, Optional ByVal PointWhatToChange As Integer = 50, Optional Mtype As Integer = PointUP) 'botschange 'we need to rework .lastmutdetail Dim Max As Long Dim temp As String Dim bp As block Dim tempbp As block Dim Name As String Dim oldname As String Dim t As Long Dim old As Long With rob(robn) For t = nth To (nth + length - 1) 'if length is 1, it's only one bp we're mutating, remember? If Timer - 4 > timee Then Exit Sub 'safe If t >= .DnaLen Then GoTo getout 'don't mutate end either If .DNA(t).tipo = 10 Then GoTo getout 'mutations can't cross control barriers If Random(0, 99) < PointWhatToChange Then ''''''''''''''''''''''''''''''''''''''''' 'Mutate VALUE ''''''''''''''''''''''''''''''''''''''''' If .DNA(t).value And Mtype = InsertionUP Then 'Insertion mutations should get a good range for value. 'Don't worry, this will get "mod"ed for non number commands. 'This doesn't count as a mutation, since the whole: ' -- Add an element, set it's tipo and value to random stuff -- is a SINGLE mutation 'we'll increment mutation counters and .lastmutdetail later. .DNA(t).value = Gauss(500, 0) 'generates values roughly between -1000 and 1000 End If old = .DNA(t).value If .DNA(t).tipo = 0 Or .DNA(t).tipo = 1 Then '(number or *number) Do If Timer - 4 > timee Then Exit Sub 'safe ' Dim a As Integer .DNA(t).value = Gauss(IIf(Abs(old) < 100, IIf(Sgn(old) = 0, Random(0, 1) * 2 - 1, Sgn(old)) * 10, old / 10), .DNA(t).value) Loop While .DNA(t).value = old .Mutations = .Mutations + 1 .LastMut = .LastMut + 1 .LastMutDetail = MutationType(Mtype) + " changed " + TipoDetok(.DNA(t).tipo) + " from" + Str(old) + " to" + Str(.DNA(t).value) + " at position" + Str(t) + " during cycle" + Str(SimOpts.TotRunCycle) + vbCrLf + .LastMutDetail Else 'find max legit value 'this should really be done a better way bp.tipo = .DNA(t).tipo Max = 0 Do If Timer - 4 > timee Then Exit Sub 'safe temp = "" Max = Max + 1 bp.value = Max Parse temp, bp Loop While temp <> "" Max = Max - 1 If Max <= 1 Then GoTo getout 'failsafe in case its an invalid type or there's no way to mutate it Do If Timer - 4 > timee Then Exit Sub 'safe .DNA(t).value = Random(1, Max) Loop While .DNA(t).value = old bp.tipo = .DNA(t).tipo bp.value = old tempbp = .DNA(t) Parse Name, tempbp ' Have to use a temp var because Parse() can change the arguments Parse oldname, bp .Mutations = .Mutations + 1 .LastMut = .LastMut + 1 .LastMutDetail = MutationType(Mtype) + " changed value of " + TipoDetok(.DNA(t).tipo) + " from " + _ oldname + " to " + Name + " at position" + Str(t) + " during cycle" + _ Str(SimOpts.TotRunCycle) + vbCrLf + .LastMutDetail End If Else bp.tipo = .DNA(t).tipo bp.value = .DNA(t).value Do If Timer - 4 > timee Then Exit Sub 'safe .DNA(t).tipo = Random(0, 20) Loop While .DNA(t).tipo = bp.tipo Or TipoDetok(.DNA(t).tipo) = "" Max = 0 If .DNA(t).tipo >= 2 Then Do If Timer - 4 > timee Then Exit Sub 'safe temp = "" Max = Max + 1 .DNA(t).value = Max Parse temp, .DNA(t) Loop While temp <> "" Max = Max - 1 If Max <= 1 Then GoTo getout 'failsafe in case its an invalid type or there's no way to mutate it .DNA(t).value = (bp.value Mod Max) 'put values in range If .DNA(t).value <= 0 Then .DNA(t).value = 1 End If Else 'we do nothing, it has to be in range End If tempbp = .DNA(t) Parse Name, tempbp ' Have to use a temp var because Parse() can change the arguments Parse oldname, bp .Mutations = .Mutations + 1 .LastMut = .LastMut + 1 .LastMutDetail = MutationType(Mtype) + " changed the " + TipoDetok(bp.tipo) + ": " + _ oldname + " to the " + TipoDetok(.DNA(t).tipo) + ": " + Name + " at position" + Str(t) + " during cycle" + _ Str(SimOpts.TotRunCycle) + vbCrLf + .LastMutDetail End If Next t getout: End With End Sub Private Sub Insertion(robn As Integer) Dim location As Integer Dim length As Integer Dim accum As Long Dim t As Long With rob(robn) For t = 1 To (.DnaLen - 1) 'botschange If Timer - 4 > timee Then Exit Sub 'safe If Rnd < 1 / .Mutables.mutarray(InsertionUP) Then If .Mutables.Mean(InsertionUP) = 0 Then .Mutables.Mean(InsertionUP) = 1 Do If Timer - 4 > timee Then Exit Sub 'safe length = Gauss(.Mutables.StdDev(InsertionUP), .Mutables.Mean(InsertionUP)) Loop While length <= 0 MakeSpace .DNA(), t + accum, length, .DnaLen rob(robn).DnaLen = rob(robn).DnaLen + length ' accum = accum + length ' ChangeDNA robn, t + accum, length, 100, InsertionUP 'set a good value up ' ChangeDNA robn, t + accum, length, 0, InsertionUP 'change type ChangeDNA robn, t + 1, length, 0, InsertionUP 'change the type first so that the mutated value is within the space of the new type ChangeDNA robn, t + 1, length, 100, InsertionUP 'set a good value up End If Next t End With End Sub Private Sub Reversal(robn As Integer) 'reverses a length of DNA Dim length As Long Dim counter As Long Dim location As Long Dim low As Long Dim high As Long Dim templong As Long Dim tempblock As block Dim t As Long Dim second As Long With rob(robn) For t = 1 To (.DnaLen - 1) If Timer - 4 > timee Then Exit Sub 'safe If Rnd < 1 / .Mutables.mutarray(ReversalUP) Then If .Mutables.Mean(ReversalUP) < 2 Then .Mutables.Mean(ReversalUP) = 2 Do If Timer - 4 > timee Then Exit Sub 'safe length = Gauss(.Mutables.StdDev(ReversalUP), .Mutables.Mean(ReversalUP)) Loop While length <= 0 length = length \ 2 'be sure we go an even amount to either side If t - length < 1 Then length = t - 1 If t + length > .DnaLen - 1 Then length = .DnaLen - 1 - t If length > 0 Then second = 0 For counter = t - length To t - 1 If Timer - 4 > timee Then Exit Sub 'safe tempblock = .DNA(counter) .DNA(counter) = .DNA(t + length - second) .DNA(t + length - second) = tempblock second = second + 1 Next counter .Mutations = .Mutations + 1 .LastMut = .LastMut + 1 .LastMutDetail = "Reversal of" + Str(length * 2 + 1) + "bps centered at " + Str(t) + " during cycle" + _ Str(SimOpts.TotRunCycle) + vbCrLf + .LastMutDetail End If End If Next t End With End Sub Private Sub MinorDeletion(robn As Integer) Dim length As Long, t As Long With rob(robn) If .Mutables.Mean(MinorDeletionUP) < 1 Then .Mutables.Mean(MinorDeletionUP) = 1 For t = 1 To (.DnaLen - 1) If Timer - 4 > timee Then Exit Sub 'safe If Rnd < 1 / .Mutables.mutarray(MinorDeletionUP) Then Do If Timer - 4 > timee Then Exit Sub 'safe length = Gauss(.Mutables.StdDev(MinorDeletionUP), .Mutables.Mean(MinorDeletionUP)) Loop While length <= 0 If t + length > .DnaLen - 1 Then length = .DnaLen - 1 - t Delete .DNA, t, length, .DnaLen .DnaLen = DnaLen(.DNA()) .LastMutDetail = "Minor Deletion deleted a run of" + _ Str(length) + " bps at position" + Str(t) + " during cycle" + _ Str(SimOpts.TotRunCycle) + vbCrLf + .LastMutDetail End If Next t End With End Sub Private Sub MajorDeletion(robn As Integer) Dim length As Long, t As Long With rob(robn) If .Mutables.Mean(MajorDeletionUP) < 1 Then .Mutables.Mean(MajorDeletionUP) = 1 For t = 1 To (.DnaLen - 1) 'botschange If Timer - 4 > timee Then Exit Sub 'safe If Rnd < 1 / .Mutables.mutarray(MajorDeletionUP) Then Do If Timer - 4 > timee Then Exit Sub 'safe length = Gauss(.Mutables.StdDev(MajorDeletionUP), .Mutables.Mean(MajorDeletionUP)) Loop While length <= 0 If t + length > .DnaLen - 1 Then length = .DnaLen - 1 - t Delete .DNA, t, length, .DnaLen .DnaLen = DnaLen(.DNA()) .Mutations = .Mutations + 1 .LastMut = .LastMut + 1 .LastMutDetail = "Major Deletion deleted a run of" + _ Str(length) + " bps at position" + Str(t) + " during cycle" + _ Str(SimOpts.TotRunCycle) + vbCrLf + .LastMutDetail End If Next t End With End Sub Private Sub Amplification(robn As Integer) On Error GoTo getout: '1. pick a spot (1 to .dnalen - 1) '2. Run a length, copied to a temporary location '3. Pick a new spot (1 to .dnalen - 1) '4. Insert copied DNA Dim t As Long Dim length As Long With rob(robn) Dim tempDNA() As block Dim start As Long Dim second As Long Dim counter As Long t = 1 Do t = t + 1 'botschange If Timer - 4 > timee Then Exit Sub 'safe If Rnd < 1 / .Mutables.mutarray(AmplificationUP) Then length = Gauss(.Mutables.StdDev(AmplificationUP), .Mutables.Mean(AmplificationUP)) If length < 1 Then length = 1 length = length - 1 length = length \ 2 If t - length < 1 Then length = t - 1 If t + length > .DnaLen - 1 Then length = .DnaLen - 1 - t If length > 0 Then ReDim tempDNA(length * 2) second = 0 For counter = t - length To t + length If Timer - 4 > timee Then Exit Sub 'safe tempDNA(second) = .DNA(counter) second = second + 1 Next counter 'we now have the appropriate length of DNA in the temporary array. 'open up a hole 'safe size If UBound(.DNA) > 5000 Then Exit Sub start = Random(1, UBound(.DNA) - 2) MakeSpace .DNA(), start, UBound(tempDNA) + 1 For counter = start + 1 To start + UBound(tempDNA) + 1 If Timer - 4 > timee Then Exit Sub 'safe .DNA(counter) = tempDNA(counter - start - 1) Next counter 'BOTSAREUSIFIED .Mutations = .Mutations + 1 .LastMut = .LastMut + 1 .LastMutDetail = "Amplification copied a series at" + Str(t) + Str(length * 2 + 1) + "bps long to " + Str(start) + " during cycle" + _ Str(SimOpts.TotRunCycle) + vbCrLf + .LastMutDetail End If End If Loop Until t = UBound(.DNA) - 1 'botschange 'add "end" to end of the DNA .DNA(UBound(.DNA)).tipo = 10 .DNA(UBound(.DNA)).value = 1 End With getout: End Sub Private Sub Translocation(robn As Integer) On Error GoTo getout: '1. pick a spot (1 to .dnalen - 1) '2. Run a length, copied to a temporary location '3. Pick a new spot (1 to .dnalen - 1) '4. Insert copied DNA Dim t As Long Dim length As Long With rob(robn) Dim tempDNA() As block Dim start As Long Dim second As Long Dim counter As Long For t = 1 To UBound(.DNA) - 1 'botschange If Timer - 4 > timee Then Exit Sub 'safe If Rnd < 1 / .Mutables.mutarray(TranslocationUP) Then length = Gauss(.Mutables.StdDev(TranslocationUP), .Mutables.Mean(TranslocationUP)) If length < 1 Then length = 1 length = length - 1 length = length \ 2 If t - length < 1 Then length = t - 1 If t + length > UBound(.DNA) - 1 Then length = UBound(.DNA) - 1 - t If length > 0 Then ReDim tempDNA(length * 2) second = 0 For counter = t - length To t + length If Timer - 4 > timee Then Exit Sub 'safe tempDNA(second) = .DNA(counter) second = second + 1 Next counter 'we now have the appropriate length of DNA in the temporary array. 'ta!da! Delete .DNA, t - length, t + length 'open up a hole start = Random(1, UBound(.DNA) - 2) MakeSpace .DNA(), start, UBound(tempDNA) + 1 For counter = start + 1 To start + UBound(tempDNA) + 1 If Timer - 4 > timee Then Exit Sub 'safe .DNA(counter) = tempDNA(counter - start - 1) Next counter 'BOTSAREUSIFIED .Mutations = .Mutations + 1 .LastMut = .LastMut + 1 .LastMutDetail = "Translocation moved a series at" + Str(t) + Str(length * 2 + 1) + "bps long to " + Str(start) + " during cycle" + _ Str(SimOpts.TotRunCycle) + vbCrLf + .LastMutDetail End If End If Next t 'botschange 'add "end" to end of the DNA .DNA(UBound(.DNA)).tipo = 10 .DNA(UBound(.DNA)).value = 1 End With getout: End Sub ' mutates robot colour in robot n a times Private Sub mutatecolors(n As Integer, a As Long) Dim color As Long Dim r As Long, g As Long, b As Long Dim counter As Long color = rob(n).color b = color \ (65536) g = color \ 256 - b * 256 r = color - b * 65536 - g * 256 For counter = 1 To a Select Case (Random(1, 3)) Case 1 b = b + (Random(0, 1) * 2 - 1) * 20 Case 2 g = g + (Random(0, 1) * 2 - 1) * 20 Case 3 r = r + (Random(0, 1) * 2 - 1) * 20 End Select If r > 255 Then r = 255 If r < 0 Then r = 0 If g > 255 Then g = 255 If g < 0 Then g = 0 If b > 255 Then b = 255 If b < 0 Then b = 0 Next counter rob(n).color = b * 65536 + g * 256 + r End Sub '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Public Function delgene(n As Integer, g As Integer) As Boolean Dim k As Integer, t As Integer k = rob(n).genenum If g > 0 And g <= k Then DeleteSpecificGene rob(n).DNA, g delgene = True rob(n).DnaLen = DnaLen(rob(n).DNA) rob(n).genenum = CountGenes(rob(n).DNA) rob(n).mem(DnaLenSys) = rob(n).DnaLen rob(n).mem(GenesSys) = rob(n).genenum makeoccurrlist n End If End Function Public Sub DeleteSpecificGene(ByRef DNA() As block, k As Integer) Dim i As Long, f As Long i = genepos(DNA, k) If i < 0 Then GoTo getout f = GeneEnd(DNA, i) Delete DNA, i, f - i + 1 ' EricL Added +1 getout: End Sub Public Sub SetDefaultMutationRates(ByRef changeme As mutationprobs) Dim a As Byte 'botschange With (changeme) For a = 0 To 8 .mutarray(a) = 2400 'botschange Next a .Mean(PointUP) = 1 .StdDev(PointUP) = 0 .Mean(DeltaUP) = 500 .StdDev(DeltaUP) = 150 .Mean(MinorDeletionUP) = 1 .StdDev(MinorDeletionUP) = 0 .Mean(InsertionUP) = 1 .StdDev(InsertionUP) = 0 .Mean(CopyErrorUP) = 1 .StdDev(CopyErrorUP) = 0 .Mean(MajorDeletionUP) = 3 .StdDev(MajorDeletionUP) = 1 .Mean(ReversalUP) = 3 .StdDev(ReversalUP) = 1 .CopyErrorWhatToChange = 80 .PointWhatToChange = 80 .Mean(AmplificationUP) = 250 .StdDev(AmplificationUP) = 75 .Mean(TranslocationUP) = 250 .StdDev(TranslocationUP) = 75 End With End Sub