[RETO] Comprobar si un numero dado es un numero de la suerte

[LeandroA]

Karcrack te queria manda un MP pero tenes la casilla llena o si estas en el msn mandame un msg

Saludos.

[Karcrack]

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

[raul338]

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

[Dessa]

EDITO:

Solo me falta un if pero no logro resolverlo, me acerqué bastante pero no alcalzó.

Código [Seleccionar] Expandir




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