I am running into an interesting problem w/ genetic distance graph. The update is lagging by a good minute with only ~7 robots on the screen. I guess linking it up to the crossover algorithm kills the speed.
Any ideas?
Here is the code, I do not think it will help much, it is really straight forward and works for crossover great:
'*** the code (snip) for genetic distance graph ***
Case GENETIC_DIST_GRAPH
t = Flex.last(nomi)
For P = 1 To t
dati(P, GENETIC_DIST_GRAPH) = 0
Next P
For t = 1 To MaxRobs
With rob(t)
If .exist And Not .Corpse Then
P = Flex.Position(rob(t).FName, nomi)
For X = t + 1 To MaxRobs
If rob(X).exist And Not rob(X).Corpse And rob(X).FName = .FName Then ' Must exist and be of same species
l = DoGeneticDistance(t, X) * 1000
If l > dati(P, GENETIC_DIST_GRAPH) Then dati(P, GENETIC_DIST_GRAPH) = l
End If
Next X
End If
End With
Next t
'*** the public function links up to graphs ***
Public Function DoGeneticDistance(r1 As Integer, r2 As Integer) As Single
Dim t As Integer
'Step1 Create block2 from robots
Dim dna1() As block2
Dim dna2() As block2
ReDim dna1(UBound(rob(r1).DNA))
For t = 0 To UBound(dna1)
dna1(t).tipo = rob(r1).DNA(t).tipo
dna1(t).value = rob(r1).DNA(t).value
Next
ReDim dna2(UBound(rob(r2).DNA))
For t = 0 To UBound(dna2)
dna2(t).tipo = rob(r2).DNA(t).tipo
dna2(t).value = rob(r2).DNA(t).value
Next
'Step2 Figure out genetic distance
iinc = 0
FindLongestSequences dna1, dna2, 0, UBound(dna1), 0, UBound(dna2)
DoGeneticDistance = GeneticDistance(dna1, dna2)
End Function
'*** The genetic distance function iteself ***
Private Function GeneticDistance(ByRef rob1() As block2, ByRef rob2() As block2) As Single
Dim diffcount As Integer
Dim a As Integer
For a = 0 To UBound(rob1)
If rob1(a).match = 0 Then diffcount = diffcount + 1
Next
For a = 0 To UBound(rob2)
If rob2(a).match = 0 Then diffcount = diffcount + 1
Next
GeneticDistance = diffcount / (UBound(rob1) + UBound(rob2) + 2)
End Function
'*** The actual cross over figure out function ***
'si = start index, ei = end index, iinc = layer
Private Sub FindLongestSequences(ByRef rob1() As block2, ByRef rob2() As block2, si1 As Integer, ei1 As Integer, si2 As Integer, ei2 As Integer)
'Step1 What index range is smaller?
Dim searchlen As Integer
searchlen = ei1 - si1
If ei2 - si2 < searchlen Then searchlen = ei2 - si2
'Step2 Recrusivelly sweep from largest to shortest searchlen until match is found
Dim mylen As Integer
For mylen = (searchlen + 1) To 1 Step -1
'Step2A The sweep itself
Dim sweep1 As Integer
Dim sweep2 As Integer
For sweep1 = si1 To ei1 - (mylen - 1)
For sweep2 = si2 To ei2 - (mylen - 1)
'the match algo
Dim lenloop As Integer
Dim allmatch As Boolean 'are all values the same for this sweep?
allmatch = True
For lenloop = 0 To mylen - 1
If rob1(lenloop + sweep1).tipo <> rob2(lenloop + sweep2).tipo Or rob1(lenloop + sweep1).value <> rob2(lenloop + sweep2).value Then
allmatch = False
Exit For
End If
Next
If allmatch Then
'match is found, goto step3
iinc = iinc + 1
For lenloop = 0 To mylen - 1
rob1(lenloop + sweep1).match = iinc
rob2(lenloop + sweep2).match = iinc
Next
GoTo step3
End If
Next
Next
Next
Exit Sub
step3:
'find lefthand subsequance
If sweep1 > si1 And sweep2 > si2 Then FindLongestSequences rob1, rob2, si1, sweep1 - 1, si2, sweep2 - 1
'find righthand subsequance
If sweep1 + (mylen - 1) < ei1 And sweep2 + (mylen - 1) < ei2 Then FindLongestSequences rob1, rob2, sweep1 + mylen, ei1, sweep2 + mylen, ei2
End Sub
edit:
I even tried adding the (.LastMut + .Mutations) > 0 condition to all robots checked, that did not help much, and besides there are ways to load two different DNA files with the same file name.