Mensajes

[DoEvents¡!]

Gracias Raul!!

DoEvents¡!

[LeandroA]

Leandro, probando como dice Karcrack (que devuelva un Boolean ingresando un numero Long) es un "Misil", muy buena, no era que las matematicas no eran tu fuerte ?

Oh dios!!
Es verdad, va como un tiro!!
Las Collections son mas apropiadas cuando se trabaja con poca cantidad de Items...
Por eso acabo de hacer esta tercera versión, es la mas rápida de las mias, y de velocidad anda pareja con la de LeandroA  :

Código (vb) [Seleccionar] Expandir


Option Explicit
Private Declare Sub RtlMoveMemory Lib "Kernel32" (ByVal Destination As Any, ByVal Source As Any, ByVal length As Long)

Public Function Check_Lucky_Number3(ByVal lNumber As Long) As Boolean
   Dim lTempArray()            As Long
   Dim NextElim                As Long
   Dim lArrayUBound            As Long
   Dim m                       As Long
   Dim x                       As Long

   If lNumber = 1 Or lNumber = 3 Then
       GoTo IsLucky
   ElseIf (lNumber > 1) And (lNumber Mod 2 <> 0) Then
       m = 1
       For x = 1 To lNumber Step 2
           ReDim Preserve lTempArray(m)
           lTempArray(m) = x
           m = m + 1
       Next
       NextElim = 3: m = 2
       Do
           x = NextElim
           Do While x <= UBound(lTempArray)
               lArrayUBound = UBound(lTempArray)
               If Not x = lArrayUBound Then
                   RtlMoveMemory VarPtr(lTempArray(x)), VarPtr(lTempArray(x + 1)), (lArrayUBound - x) * 4
                   ReDim Preserve lTempArray(lArrayUBound - 1)
               Else
                   Exit Function
               End If
               x = x + (NextElim - 1)
           Loop
           m = m + 1
           NextElim = lTempArray(m)
       Loop While Not NextElim > lArrayUBound
IsLucky: Check_Lucky_Number3 = True
   End If
End Function

Testeado con GetTickCount:

LeandroA IsLuckyNumber ---> 125
PsyKe1 Check_Lucky_Number3 ---> 125

@Dessa
Me referia a que hicieses algo asi:

Código (vb) [Seleccionar] Expandir

Option Explicit

Function IsLucky2(lngNum As Long) As Boolean
   Dim x As Long, cont As Long, contStep As Long, Indice As Long, numLuck() As String
   
   If lngNum < 1 Or lngNum Mod 2 = 0 Or lngNum = 5 Then Exit Function
   If lngNum = 1 Or lngNum = 3 Then IsLucky2 = True: Exit Function
   
   For x = 1 To lngNum Step 2
         ReDim Preserve numLuck(contStep)
         numLuck(contStep) = x
         contStep = contStep + 1
   Next
   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 ReDim Preserve numLuck(contStep - 2) Else ReDim Preserve numLuck(contStep - 1)
     If numLuck(UBound(numLuck)) <> lngNum Then Exit Function
      cont = 0
     contStep = 0
     Indice = Indice + 1
   Wend
   
   IsLucky2 = True
End Function

IsLucky : 147,75 ms
IsLucky2 : 87,45 ms



@Karcrack
Una duda con tu code:

Código (vb) [Seleccionar] Expandir

If (lNumb And 1 = 0) Then Exit Function
Esto para que es?¿  
Es como hacer Mod?¿


DoEvents¡!

[DoEvents¡!]

Oops LeandroA, nuestras funciones van practicamente igual de rapido... 

DoEvents¡!

[Dessa]

Hola Dessa!!

He mirado el code, puedes ganar un poco de velocidad si haces esto:

Código (vb) [Seleccionar] Expandir

If numLuck(UBound(numLuck)) = lngNum Then IsLucky = True

En vez de esto:

Código (vb) [Seleccionar] Expandir

For x = 0 To UBound(numLuck)
If numLuck(x) = lngNum Then
  IsLucky = True
  Exit For
End If
Next

Teniendo en cuenta que el número que buscas siempre estara el ultimo,y te evitas recorrer tooooooodo el array, mas tarde lo miro con mas detenimiento que tengo prisa...

DoEvents¡!

[DoEvents¡!]

@*PsYkE1*

¿No estará Bianc4 de vacaciones?....jeje

P.D. Es broma 

salu2.

No se, ultimamente esta un poco callada, me niega el saludo, y no para de decirme que entre en el maldito Blog... 

El problema ya esta solucionado, no tengo ni idea de porque pero lo importante es que ahora si que puedo entrar con voz...

DoEvents¡!

[Karcrack]

Jajajajaja...! *PsYkE1* te has vuelto un adicto al Collection...!

Excelente trabajo...! Me gustó..!

Jajajajajaja 
Eso es por culpa de Karcrack! 
Él me volvió adicto...

Mi codigo todavia no es funcional, tiene varios fallos, por ejemplo, en la segunda llamada da errores, debido a que dejo las variables llenas de basura... a ver si consigo mañana algo de tiempo y hago la version raaaapida

Buen trabajo Psyke, veo que has exprimido al maximo las neuronas, a mi me dejo con dolor de cabeza , tanto tiempo sin pensar...

Gracias¡!
Si te digo la verdad, en un momento me pareció tan desesperante que pense en mandarlo a la m****a...
Aun asi el reto me gustó, de paso planteo una pregunta:
Esto que hemos hecho tiene alguna utilidad?¿

DoEvents¡!

[cTiming.cls]

Me he tomado la libertad de ir testeando, aunque habria que probarlo en más PCs...
Utilizando:
cTiming.cls

Código (vb) [Seleccionar] Expandir

Private tmr     As CTiming

Option Explicit
Option Base 1

'Karcrack
Public Static Function IsItLucky(ByVal lNumb As Long) As Boolean
    Dim bvSieve()   As Byte
    Dim lJump       As Long
    Dim lLastNumb   As Long
    Dim i           As Long
    Dim iCount      As Long
    Dim xCount      As Long
    Dim x           As Long

    If lNumb = 1 Or lNumb = 3 Then IsItLucky = True: Exit Function

    If (lNumb And 1 = 0) Then Exit Function

    If lJump = 0 Then lJump = 2

    If lLastNumb < lNumb Then
        ReDim Preserve bvSieve(lNumb)

        iCount = 0
        xCount = 1

        Do
            For i = 1 To lNumb
                If bvSieve(i) = False Then iCount = iCount + 1
                If iCount = lJump Then
                    bvSieve(i) = True
                    iCount = 0
                End If
            Next i
            iCount = 0
            xCount = xCount + 1
            For i = 1 To lNumb
                If bvSieve(i) = False Then
                    x = x + 1
                    If x = xCount Then
                        lJump = i
                        x = 0
                        Exit For
                    End If
                End If
            Next i
        Loop Until xCount > lJump
    End If

    IsItLucky = Not bvSieve(lNumb)

    lLastNumb = lNumb
End Function

'*PsYkE1*
Public Function Check_Lucky_Number(ByVal lNumber As Long) As Boolean
    Dim cTemp                   As New Collection
    Dim NextElim                As Long
    Dim m                       As Long
    Dim x                       As Long

    If lNumber = 1 Or lNumber = 3 Then
        GoTo IsLucky
    ElseIf (lNumber > 1) And (lNumber Mod 2 <> 0) Then
        With cTemp
            For x = 1 To lNumber Step 2
                .Add x
            Next
            NextElim = 3: m = 2
            Do
                x = NextElim
                Do While x <= .Count
                    .Remove (x)
                    x = x + (NextElim - 1)
                Loop
                If .Item(.Count) = lNumber Then
                    m = m + 1
                    NextElim = .Item(m)
                Else
                    Exit Function
                End If
            Loop While Not NextElim > .Count
        End With
IsLucky: Check_Lucky_Number = True
    End If
End Function

' LeandroA
Private Function IsLuckyNumber(ByVal Num As Long) As Boolean

    Dim lCount As Long, lPos As Long
    Dim c As New Collection

    If Num < 1 Then Exit Function
    If Num Mod 2 = 0 Then Exit Function

    For lPos = 1 To Num Step 2
        c.Add lPos
    Next

    lCount = 1

    Do While c.Count > lCount

        lCount = lCount + 1
        lPos = c(lCount)

        Do
            If lPos > c.Count Then Exit Do
            c.Remove lPos
            lPos = lPos + c(lCount) - 1
        Loop

        If c(c.Count) <> Num Then Exit Function
    Loop

    IsLuckyNumber = True

End Function

Private Sub Form_Load()
    Dim x           As Long
    Dim sResult     As String
   
    Set tmr = New CTiming
    tmr.Reset
   
    For x = 1 To 500
        If IsLuckyNumber(x) Then ' Aqui los voy probando uno a uno... :P
            sResult = sResult & x & " "
        End If
    Next
    MsgBox tmr.sElapsed
   
    Debug.Print sResult
End Sub


Mis resultados:

LeandroA: 28,734
Karcrack : 69,309
*PsYkE1* : 19,923

DoEvents¡!

[DOS]

Bueno, ya lo tengo...

El algoritmo se las trae!!

Ya te digo, me costó bastante...

Traigo DOS formas de hacerlo:

1ª Forma:
Es como yo lo haría, que mas "chulo" con Collections:

Código (vb) [Seleccionar] Expandir


Option Explicit

Public Function Check_Lucky_Number(ByVal lNumber As Long) As Boolean
   Dim cTemp                   As New Collection
   Dim NextElim                As Long
   Dim m                       As Long
   Dim x                       As Long
   
   If lNumber = 1 Or lNumber = 3 Then
       GoTo IsLucky
   ElseIf (lNumber > 1) And (lNumber Mod 2 <> 0) Then
       With cTemp
           For x = 1 To lNumber Step 2
               .Add x
           Next
           NextElim = 3 : m = 2
           Do
               x = NextElim
               Do While x <= .Count
                   .Remove (x)
                   x = x + (NextElim - 1)
               Loop
               If .Item(.Count) = lNumber Then
                   m = m + 1
                   NextElim = .Item(m)
               Else
                   Exit Function
               End If
           Loop While Not NextElim > .Count
       End With
IsLucky: Check_Lucky_Number = True
   End If
End Function

2ª Forma:
Aqui utilizo un Array:

Código (vb) [Seleccionar] Expandir


Option Explicit
Public Function Check_Lucky_Number2(ByVal lNumber As Long) As Boolean
   Dim lTempArray()            As Long
   Dim NextElim                As Long
   Dim m                       As Long
   Dim x                       As Long
   
   If lNumber = 1 Or lNumber = 3 Then
       GoTo IsLucky
   ElseIf (lNumber > 1) And (lNumber Mod 2 <> 0) Then
       m = 1
       For x = 1 To lNumber Step 2
           ReDim Preserve lTempArray(m)
           lTempArray(m) = x
           m = m + 1
       Next
       NextElim = 3 : m = 2
       Do
           x = NextElim
           Do While x <= UBound(lTempArray)
               Call Delete_Array_Item(lTempArray, x)
               x = x + (NextElim - 1)
           Loop
           If lTempArray(UBound(lTempArray)) = lNumber Then
               m = m + 1
               NextElim = lTempArray(m)
           Else
               Exit Function
           End If
       Loop While Not NextElim > UBound(lTempArray)
IsLucky: Check_Lucky_Number2 = True
   End If
End Function
' Esto lo hace MUY lento... :( Mirar sig version en la pág siguiente ;)
Private Sub Delete_Array_Item(ByRef lArray() As Long, ByVal lIndex As Long)
   Dim lCount      As Long
   Dim x           As Long
   
   lCount = UBound(lArray)
   If lIndex <= lCount And lIndex >= LBound(lArray) Then
       For x = lIndex To lCount - 1
           lArray(x) = lArray(x + 1)
       Next
       ReDim Preserve lArray(lCount - 1)
   End If
End Sub



Para probarlas:

Código (vb) [Seleccionar] Expandir

Private Sub Form_Load()
   Dim x           As Long
   Dim sResult     As String
   
   For x = 1 To 200
       'If Check_Lucky_Number2(x) Then
       If Check_Lucky_Number(x) Then
           sResult = sResult & x & " "
       End If
   Next
   Debug.Print sResult
End Sub

Ambas me devuelven esto:

1 3 7 9 13 15 21 25 31 33 37 43 49 51 63 67 69 73 75 79 87 93 99 105 111 115 127 129 133 135 141 151 159 163 169 171 189 193 195

DoEvents¡!

[DoEvents¡!]

Tambien, pero la duda ya esta resuelta queria hacerlo como puso Karcrack

DoEvents¡!

[Novlucker]

Claro, claro, eso ya lo hice, si ya me ayudo Novlucker y Kasswed y llege a tener voz...

DoEvents¡!