Buaaah!!! No he conseguido batir al codigo de Tokes, incluso haciendo el algoritmo en ASM... (Resulta que tardo casi lo mismo en cargar el codigo (vTable) que en hacer el algoritmo entero )
Para mi hay un ganador claro a no ser que se demuestre lo contrario... ... Asi que, ire pensando otro reto
yo queria participar y se me habia ocurrido la idea del redim, pero no me salio el algoritmo y me negaba a fijarme en sus codigos y hasta se me ocurrio usar listas enlazadas y doblemente enlazadas, pero mi base del algoritmo fallaba
Muy impresionante lo que hicieron, y si, ya deberian ir cerrando y proclamar un ganador. Yo tengo un reto para mas tarde
Solo me falta un if pero no logro resolverlo, me acerqué bastante pero no alcalzó.
Código:
Option Explicit Private Declare Function GetTickCount Lib "Kernel32" () As Long
Private Sub Form_Load() Dim x As Long Dim s As String Dim t1 As Long Dim t2 As Long
If App.LogMode = 0 Then MsgBox "Ejecutar compilado" End End If
Me.AutoRedraw = True
'Dessa Me.Print "Dessa" t1 = GetTickCount For x = 5000 To 7000 If IsLucky(x) Then s = s & x & " " End If Next t2 = GetTickCount Me.Print t2 - t1 & vbNewLine
MsgBox s, vbOKOnly, "Dessa" s = ""
'Tokes Me.Print "Tokes" t1 = GetTickCount For x = 5000 To 7000 If verifnum4(x) Then s = s & x & " " End If Next t2 = GetTickCount Me.Print t2 - t1 & vbNewLine MsgBox s, vbOKOnly, "Tokes" s = "" End Sub
'Dessa
Function IsLucky(lngNum As Long) As Boolean
Dim x As Long Dim cont As Long Dim contStep As Long Dim Indice As Long Dim numLuck() As Long
If lngNum < 1 Then Exit Function If lngNum Mod 2 = 0 Then Exit Function If lngNum = 1 Or lngNum = 3 Then IsLucky = True Exit Function End If If lngNum = 5 Then Exit Function
ReDim numLuck(lngNum) For x = 1 To lngNum Step 2 numLuck(contStep) = x contStep = contStep + 1 Next ReDim Preserve numLuck(contStep - 1)
contStep = 0 cont = 0 Indice = 1
While numLuck(Indice) <= UBound(numLuck) For x = 0 To UBound(numLuck) If cont = numLuck(Indice) - 1 Then cont = 0 Else numLuck(contStep) = numLuck(x) cont = cont + 1 contStep = contStep + 1 End If Next If contStep = numLuck(Indice + 1) Then Exit Function Else ReDim Preserve numLuck(contStep - 1) If numLuck(UBound(numLuck)) <> lngNum Then Exit Function End If cont = 0 contStep = 0 Indice = Indice + 1 Wend IsLucky = True
End Function
' Tokes (Cuarto intento) Private Function verifnum4(ByVal Num As Long) As Boolean Dim bufA() As Long Dim indElim As Long Dim indElim_aux As Long Dim ordenElim As Long Dim i As Long Dim i_auxA As Long Dim i_auxB As Long
If (Num And 1) = 0 Then Exit Function End If If Num < 5 Then verifnum4 = True Exit Function End If
ReDim bufA(0 To Num)
ordenElim = 2 i = 1 For i_auxA = 1 To Num Step 2 bufA(i) = i_auxA i = i + 1 Next i_auxA i = i - 1
Do indElim = bufA(ordenElim) If indElim > i Then verifnum4 = True Exit Function End If If indElim = i Then Exit Function i_auxA = indElim i_auxB = indElim + 1 Do For indElim_aux = indElim - 2 To 0 Step -1 If i_auxB > i Then Exit Do bufA(i_auxA) = bufA(i_auxB) i_auxA = i_auxA + 1 i_auxB = i_auxB + 1 Next indElim_aux If i_auxB = i Then Exit Function i_auxB = i_auxB + 1 Loop i = i_auxA - 1 ordenElim = ordenElim + 1 Loop End Function
« Última modificación: 18 Agosto 2010, 23:32 pm por Dessa »