I am working on it right now, it is just bloody slow, and the 32 second restriction is not helping much.
'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, ByVal timee As Long)
'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
If Timer - 5 > timee Then Exit Sub 'safe Botsarreusnotdone changed 32 to 5, debug
'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, timee
'find righthand subsequance
If sweep1 + (mylen - 1) < ei1 And sweep2 + (mylen - 1) < ei2 Then FindLongestSequences rob1, rob2, sweep1 + mylen, ei1, sweep2 + mylen, ei2, timee
End Sub
'Step2 Find longest sequance
iinc = 0
FindLongestSequences dna1, dna2, 0, UBound(dna1), 0, UBound(dna2), Timer
'If robot is too unsimiler then do not reproduce and block sex reproduction for 16 cycles
MsgBox GeneticDistance(dna1, dna2)
If GeneticDistance(dna1, dna2) > 0.6 Then
rob(female).fertilized = -26
Exit Function
End If
'Step3 do crossover and optionaly save to file
Dim Outdna() As block
ReDim Outdna(0)
crossover dna1, dna2, Outdna
The crossover itself is fine, it is the figuring out of what to crossover a complete pain.