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

[Karcrack]

Antes que nada:

Código [Seleccionar] Expandir

http://es.wikipedia.org/wiki/N%C3%BAmero_de_la_suerte

La función ha de recibir el numero (LONG) y devolver True o False (BOOLEAN) en caso de que sea o no un numero de la suerte

El reto es a ver quien consigue hacer la comprobacion mas rapida
Es un reto similar a este, pero las propiedades de los numeros de la suerte son distintas


Suerte, y yo voy a preparar ahora mi codigo

[[Zero]]

¿Como medimos el tiempo?  Interesante propuesta, me pongo a ello  .

Saludos

[Karcrack]

¿Como medimos el tiempo?  Interesante propuesta, me pongo a ello  .

Saludos

Código [Seleccionar] Expandir

http://www.xbeat.net/vbspeed/download/CTiming.zip
http://www.xbeat.net/vbspeed/details.htm#How I Time

Lo mas seguro es que si puede Seba revise los tiempos, es recomendable hacer todas las pruebas desde el mismo PC

[[Zero]]

¿Pero sólo se puede en VB o puedes medir mi código en ASM?

Saludos

[Karcrack]

El algoritmo se las trae!! Despues de casi una hora he conseguido una version que no optimizada al maximo... aqui esta:

Código (vb) [Seleccionar] Expandir

Option Explicit
Option Base 1

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


¿Pero sólo se puede en VB o puedes medir mi código en ASM?

Saludos

Si consigues hacerlo en ASM tranquilo que sabras como medir el tiempo con QueryPerformanceCounter  
No son horas para estar por el foro... madre mia.. habia creado el tema en A&D de Malware, mejor sera que me vaya a dormir  

[EddyW]

He probado tu código, pero me da mal los resultados,

Código [Seleccionar] Expandir

1, 3, 7, 9, 13, 15, 21, 25, 31, 33, 37, 43, 49, 51, 63, 67, 69, 73, 75, 79, 87, 93, 99...

A la primera vez si intentas con 1,3,7,9,13, el 15 no sale, y si vuelves a intentar algún numero no da, no se si me expliqué, pero no funca bien.

Trabajo ahora en el mio

SaluDOS!!!

[BlackZeroX]

me uno aqui pondre el mio!¡.

P.D.: Esta algo canijo xP...

Ducles Lunas!¡.

[LeandroA]

bueno para quemar algunas neuras (quedan poquitas  ) , no testie la velocidad pero me conformo con que ande  

Código (vb) [Seleccionar] Expandir


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


uso:

Código (vb) [Seleccionar] Expandir

Private Sub Form_Load()
   Dim i As Long
   Dim s As String
   For i = 1 To 200
       If IsLuckyNumber(i) Then
           s = s & i & " "
       End If
   Next
   Debug.Print s
End Sub

Saludos.

[Psyke1]

Me apunto!!! 

DoEvents¡!

[Psyke1]

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¡!