Foro de elhacker.net

Programación => Programación Visual Basic => Mensaje iniciado por: Karcrack en 11 Agosto 2010, 00:55 am


Título: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Karcrack en 11 Agosto 2010, 00:55 am
Antes que nada:
Código:
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 (http://foro.elhacker.net/programacion_visual_basic/snippetreto_isitprime_comprobar_si_un_numero_es_primo-t298929.0.html), pero las propiedades de los numeros de la suerte son distintas


Suerte, y yo voy a preparar ahora mi codigo :)

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: [Zero] en 11 Agosto 2010, 01:12 am
¿Como medimos el tiempo?  :huh: Interesante propuesta, me pongo a ello  ;D.

Saludos

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Karcrack en 11 Agosto 2010, 01:20 am
Cita de: [Zero] en 11 Agosto 2010, 01:12 am
¿Como medimos el tiempo?  :huh: Interesante propuesta, me pongo a ello  ;D.

Saludos
Código:
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 :D

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: [Zero] en 11 Agosto 2010, 02:09 am
¿Pero sólo se puede en VB o puedes medir mi código en ASM?

Saludos

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Karcrack en 11 Agosto 2010, 02:49 am
El algoritmo se las trae!! Despues de casi una hora he conseguido una version que no optimizada al maximo... aqui esta:
Código
  1. Option Explicit
  2. Option Base 1
  3.  
  4. Public Static Function IsItLucky(ByVal lNumb As Long) As Boolean
  5.     Dim bvSieve()   As Byte
  6.     Dim lJump       As Long
  7.     Dim lLastNumb   As Long
  8.     Dim i           As Long
  9.     Dim iCount      As Long
  10.     Dim xCount      As Long
  11.     Dim x           As Long
  12.  
  13.     If lNumb = 1 Or lNumb = 3 Then IsItLucky = True: Exit Function
  14.  
  15.     If (lNumb And 1 = 0) Then Exit Function
  16.  
  17.     If lJump = 0 Then lJump = 2
  18.  
  19.     If lLastNumb < lNumb Then
  20.         ReDim Preserve bvSieve(lNumb)
  21.  
  22.         iCount = 0
  23.         xCount = 1
  24.  
  25.         Do
  26.             For i = 1 To lNumb
  27.                 If bvSieve(i) = False Then iCount = iCount + 1
  28.                 If iCount = lJump Then
  29.                     bvSieve(i) = True
  30.                     iCount = 0
  31.                 End If
  32.             Next i
  33.             iCount = 0
  34.             xCount = xCount + 1
  35.             For i = 1 To lNumb
  36.                 If bvSieve(i) = False Then
  37.                     x = x + 1
  38.                     If x = xCount Then
  39.                         lJump = i
  40.                         x = 0
  41.                         Exit For
  42.                     End If
  43.                 End If
  44.             Next i
  45.         Loop Until xCount > lJump
  46.     End If
  47.  
  48.     IsItLucky = Not bvSieve(lNumb)
  49.  
  50.     lLastNumb = lNumb
  51. End Function
  52.  
Cita de: [Zero] en 11 Agosto 2010, 02:09 am
¿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 >:D  :xD :xD
 :laugh: :laugh: :laugh: :laugh: :laugh: :laugh: :laugh: :laugh: :laugh: 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 :-[  :laugh: :laugh: :laugh:

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: EddyW en 11 Agosto 2010, 03:15 am
He probado tu código, pero me da mal los resultados,
Código:
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 :D

SaluDOS!!!

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: BlackZeroX en 11 Agosto 2010, 03:21 am
me uno aqui pondre el mio!¡.

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

Ducles Lunas!¡.

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: LeandroA en 11 Agosto 2010, 07:52 am
bueno para quemar algunas neuras (quedan poquitas  >:() , no testie la velocidad pero me conformo con que ande  ;D

Código
  1. Private Function IsLuckyNumber(ByVal Num As Long) As Boolean
  2.  
  3.     Dim lCount As Long, lPos As Long
  4.     Dim c As New Collection
  5.  
  6.     If Num < 1 Then Exit Function
  7.     If Num Mod 2 = 0 Then Exit Function
  8.  
  9.     For lPos = 1 To Num Step 2
  10.         c.Add lPos
  11.     Next
  12.  
  13.     lCount = 1
  14.  
  15.     Do While c.Count > lCount
  16.  
  17.         lCount = lCount + 1
  18.         lPos = c(lCount)
  19.  
  20.         Do
  21.             If lPos > c.Count Then Exit Do
  22.             c.Remove lPos
  23.             lPos = lPos + c(lCount) - 1
  24.         Loop
  25.  
  26.         If c(c.Count) <> Num Then Exit Function
  27.     Loop
  28.  
  29.     IsLuckyNumber = True
  30.  
  31. End Function
  32.  

uso:

Código
  1. Private Sub Form_Load()
  2.     Dim i As Long
  3.     Dim s As String
  4.     For i = 1 To 200
  5.         If IsLuckyNumber(i) Then
  6.             s = s & i & " "
  7.         End If
  8.     Next
  9.     Debug.Print s
  10. End Sub

Saludos.

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Psyke1 en 11 Agosto 2010, 14:51 pm
Me apunto!!!  :D

DoEvents¡! :P

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Psyke1 en 12 Agosto 2010, 13:35 pm
Bueno, ya lo tengo... :D
Citar
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
  1. Option Explicit
  2.  
  3. Public Function Check_Lucky_Number(ByVal lNumber As Long) As Boolean
  4.     Dim cTemp                   As New Collection
  5.     Dim NextElim                As Long
  6.     Dim m                       As Long
  7.     Dim x                       As Long
  8.  
  9.     If lNumber = 1 Or lNumber = 3 Then
  10.         GoTo IsLucky
  11.     ElseIf (lNumber > 1) And (lNumber Mod 2 <> 0) Then
  12.         With cTemp
  13.             For x = 1 To lNumber Step 2
  14.                 .Add x
  15.             Next
  16.             NextElim = 3 : m = 2
  17.             Do
  18.                 x = NextElim
  19.                 Do While x <= .Count
  20.                     .Remove (x)
  21.                     x = x + (NextElim - 1)
  22.                 Loop
  23.                 If .Item(.Count) = lNumber Then
  24.                     m = m + 1
  25.                     NextElim = .Item(m)
  26.                 Else
  27.                     Exit Function
  28.                 End If
  29.             Loop While Not NextElim > .Count
  30.         End With
  31. IsLucky: Check_Lucky_Number = True
  32.     End If
  33. End Function

2ª Forma:
Aqui utilizo un Array:

Código
  1. Option Explicit
  2. Public Function Check_Lucky_Number2(ByVal lNumber As Long) As Boolean
  3.     Dim lTempArray()            As Long
  4.     Dim NextElim                As Long
  5.     Dim m                       As Long
  6.     Dim x                       As Long
  7.  
  8.     If lNumber = 1 Or lNumber = 3 Then
  9.         GoTo IsLucky
  10.     ElseIf (lNumber > 1) And (lNumber Mod 2 <> 0) Then
  11.         m = 1
  12.         For x = 1 To lNumber Step 2
  13.             ReDim Preserve lTempArray(m)
  14.             lTempArray(m) = x
  15.             m = m + 1
  16.         Next
  17.         NextElim = 3 : m = 2
  18.         Do
  19.             x = NextElim
  20.             Do While x <= UBound(lTempArray)
  21.                 Call Delete_Array_Item(lTempArray, x)
  22.                 x = x + (NextElim - 1)
  23.             Loop
  24.             If lTempArray(UBound(lTempArray)) = lNumber Then
  25.                 m = m + 1
  26.                 NextElim = lTempArray(m)
  27.             Else
  28.                 Exit Function
  29.             End If
  30.         Loop While Not NextElim > UBound(lTempArray)
  31. IsLucky: Check_Lucky_Number2 = True
  32.     End If
  33. End Function
  34. ' Esto lo hace MUY lento... :( Mirar sig version en la pág siguiente ;)
  35. Private Sub Delete_Array_Item(ByRef lArray() As Long, ByVal lIndex As Long)
  36.     Dim lCount      As Long
  37.     Dim x           As Long
  38.  
  39.     lCount = UBound(lArray)
  40.     If lIndex <= lCount And lIndex >= LBound(lArray) Then
  41.         For x = lIndex To lCount - 1
  42.             lArray(x) = lArray(x + 1)
  43.         Next
  44.         ReDim Preserve lArray(lCount - 1)
  45.     End If
  46. End Sub


Para probarlas:
Código
  1. Private Sub Form_Load()
  2.     Dim x           As Long
  3.     Dim sResult     As String
  4.  
  5.     For x = 1 To 200
  6.         'If Check_Lucky_Number2(x) Then
  7.         If Check_Lucky_Number(x) Then
  8.             sResult = sResult & x & " "
  9.         End If
  10.     Next
  11.     Debug.Print sResult
  12. End Sub

Ambas me devuelven esto:
Citar
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¡! :P

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Psyke1 en 12 Agosto 2010, 17:02 pm
Me he tomado la libertad de ir testeando, aunque habria que probarlo en más PCs...
Utilizando:
cTiming.cls (http://www.xbeat.net/vbspeed/download/CTiming.zip)

Código
  1. Private tmr     As CTiming
  2.  
  3. Option Explicit
  4. Option Base 1
  5.  
  6. 'Karcrack
  7. Public Static Function IsItLucky(ByVal lNumb As Long) As Boolean
  8.     Dim bvSieve()   As Byte
  9.     Dim lJump       As Long
  10.     Dim lLastNumb   As Long
  11.     Dim i           As Long
  12.     Dim iCount      As Long
  13.     Dim xCount      As Long
  14.     Dim x           As Long
  15.  
  16.     If lNumb = 1 Or lNumb = 3 Then IsItLucky = True: Exit Function
  17.  
  18.     If (lNumb And 1 = 0) Then Exit Function
  19.  
  20.     If lJump = 0 Then lJump = 2
  21.  
  22.     If lLastNumb < lNumb Then
  23.         ReDim Preserve bvSieve(lNumb)
  24.  
  25.         iCount = 0
  26.         xCount = 1
  27.  
  28.         Do
  29.             For i = 1 To lNumb
  30.                 If bvSieve(i) = False Then iCount = iCount + 1
  31.                 If iCount = lJump Then
  32.                     bvSieve(i) = True
  33.                     iCount = 0
  34.                 End If
  35.             Next i
  36.             iCount = 0
  37.             xCount = xCount + 1
  38.             For i = 1 To lNumb
  39.                 If bvSieve(i) = False Then
  40.                     x = x + 1
  41.                     If x = xCount Then
  42.                         lJump = i
  43.                         x = 0
  44.                         Exit For
  45.                     End If
  46.                 End If
  47.             Next i
  48.         Loop Until xCount > lJump
  49.     End If
  50.  
  51.     IsItLucky = Not bvSieve(lNumb)
  52.  
  53.     lLastNumb = lNumb
  54. End Function
  55.  
  56. '*PsYkE1*
  57. Public Function Check_Lucky_Number(ByVal lNumber As Long) As Boolean
  58.     Dim cTemp                   As New Collection
  59.     Dim NextElim                As Long
  60.     Dim m                       As Long
  61.     Dim x                       As Long
  62.  
  63.     If lNumber = 1 Or lNumber = 3 Then
  64.         GoTo IsLucky
  65.     ElseIf (lNumber > 1) And (lNumber Mod 2 <> 0) Then
  66.         With cTemp
  67.             For x = 1 To lNumber Step 2
  68.                 .Add x
  69.             Next
  70.             NextElim = 3: m = 2
  71.             Do
  72.                 x = NextElim
  73.                 Do While x <= .Count
  74.                     .Remove (x)
  75.                     x = x + (NextElim - 1)
  76.                 Loop
  77.                 If .Item(.Count) = lNumber Then
  78.                     m = m + 1
  79.                     NextElim = .Item(m)
  80.                 Else
  81.                     Exit Function
  82.                 End If
  83.             Loop While Not NextElim > .Count
  84.         End With
  85. IsLucky: Check_Lucky_Number = True
  86.     End If
  87. End Function
  88.  
  89. ' LeandroA
  90. Private Function IsLuckyNumber(ByVal Num As Long) As Boolean
  91.  
  92.     Dim lCount As Long, lPos As Long
  93.     Dim c As New Collection
  94.  
  95.     If Num < 1 Then Exit Function
  96.     If Num Mod 2 = 0 Then Exit Function
  97.  
  98.     For lPos = 1 To Num Step 2
  99.         c.Add lPos
  100.     Next
  101.  
  102.     lCount = 1
  103.  
  104.     Do While c.Count > lCount
  105.  
  106.         lCount = lCount + 1
  107.         lPos = c(lCount)
  108.  
  109.         Do
  110.             If lPos > c.Count Then Exit Do
  111.             c.Remove lPos
  112.             lPos = lPos + c(lCount) - 1
  113.         Loop
  114.  
  115.         If c(c.Count) <> Num Then Exit Function
  116.     Loop
  117.  
  118.     IsLuckyNumber = True
  119.  
  120. End Function
  121.  
  122. Private Sub Form_Load()
  123.     Dim x           As Long
  124.     Dim sResult     As String
  125.  
  126.     Set tmr = New CTiming
  127.     tmr.Reset
  128.  
  129.     For x = 1 To 500
  130.         If IsLuckyNumber(x) Then ' Aqui los voy probando uno a uno... :P
  131.             sResult = sResult & x & " "
  132.         End If
  133.     Next
  134.     MsgBox tmr.sElapsed
  135.  
  136.     Debug.Print sResult
  137. End Sub

Mis resultados:

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

DoEvents¡! :P

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: ssccaann43 © en 12 Agosto 2010, 18:22 pm
Jajajajaja...! *PsYkE1* te has vuelto un adicto al Collection...!

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

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Karcrack en 12 Agosto 2010, 23:53 pm
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 :P

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

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Psyke1 en 13 Agosto 2010, 00:05 am
Cita de: ssccaann43 en 12 Agosto 2010, 18:22 pm
Jajajajaja...! *PsYkE1* te has vuelto un adicto al Collection...!

Excelente trabajo...! Me gustó..!
Jajajajajaja  :laugh: :laugh:
Eso es por culpa de Karcrack!  :silbar: :xD
Él me volvió adicto... ;)
Cita de: Karcrack en 12 Agosto 2010, 23:53 pm
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 :P

Buen trabajo Psyke, veo que has exprimido al maximo las neuronas, a mi me dejo con dolor de cabeza :xD, tanto tiempo sin pensar... :-[ :laugh:
Gracias¡! :D
Si te digo la verdad, en un momento me pareció tan desesperante que pense en mandarlo a la m****a... :xD
Aun asi el reto me gustó, de paso planteo una pregunta:
Esto que hemos hecho tiene alguna utilidad?¿ :huh:

DoEvents¡! :P

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Dessa en 13 Agosto 2010, 06:10 am
Bueno, como se dijo, no me impota el tiempo, me conformo con que funcione... espero ...porque la verdad es que me costó un huevo (el izquierdo). :xD ,  lo dicho con que funcione está bien para mí.

Código:

Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long

Private Sub Form_Load()
  
    
    Dim t1 As Long
    Dim t2 As Long
    t1 = GetTickCount
  
    Me.AutoRedraw = True
    
    Me.Print IsLucky(45235)
   
    t2 = GetTickCount
    
    Me.Print t2 - t1
    
    
   
End Sub

Function IsLucky(lngNum As Long) As Boolean

Dim x As Long, cont As Long, contStep As Long, Indice As Long, numLuck() As String
 
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
If lngNum = 5 Then 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)
  End If
  cont = 0
  contStep = 0
  Indice = Indice + 1
Wend

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

End Function





Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Psyke1 en 13 Agosto 2010, 09:50 am
Hola Dessa!!

He mirado el code, puedes ganar un poco de velocidad si haces esto:
Código
  1. If numLuck(UBound(numLuck)) = lngNum Then IsLucky = True

En vez de esto:
Código
  1. For x = 0 To UBound(numLuck)
  2.  If numLuck(x) = lngNum Then
  3.    IsLucky = True
  4.    Exit For
  5.  End If
  6. 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¡! :P

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: LeandroA en 13 Agosto 2010, 11:57 am
Aca otra version mas rapida de la mia pero sin collection y con array. esta utiliza CopyMemory segun como esta aqui (http://www.leandroascierto.com.ar/foro/index.php?topic=105.msg406#msg406)

Código
  1. Option Explicit
  2. Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
  3.  
  4. Private Function IsLuckyNumber(ByVal Num As Long) As Boolean
  5.  
  6.     Dim lCount As Long, lPos As Long, i As Long
  7.     Dim Arr() As Long
  8.  
  9.     If Num < 1 Then Exit Function
  10.     If Num Mod 2 = 0 Then Exit Function
  11.  
  12.     For lPos = 1 To Num Step 2
  13.          i = i + 1
  14.          ReDim Preserve Arr(i)
  15.          Arr(i) = lPos
  16.     Next
  17.  
  18.     lCount = 1
  19.  
  20.     Do While UBound(Arr) > lCount
  21.  
  22.         lCount = lCount + 1
  23.         lPos = Arr(lCount)
  24.  
  25.         Do
  26.             If lPos > UBound(Arr) Then Exit Do
  27.             If lPos < UBound(Arr) Then CopyMemory Arr(lPos), Arr(lPos + 1), 4 * (UBound(Arr) - lPos)
  28.             ReDim Preserve Arr(UBound(Arr) - 1)
  29.             lPos = lPos + Arr(lCount) - 1
  30.         Loop
  31.  
  32.         If Arr(UBound(Arr)) <> Num Then Exit Function
  33.     Loop
  34.  
  35.     IsLuckyNumber = True
  36.  
  37. End Function
  38.  

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: LeandroA en 13 Agosto 2010, 12:23 pm
a con esto es mas rapido

Código:
    ReDim Preserve Arr(CLng(Num / 2) + (Num Mod 2))
    
    For lPos = 1 To Num Step 2
         i = i + 1
         Arr(i) = lPos
    Next

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Psyke1 en 13 Agosto 2010, 12:44 pm
Oops LeandroA, nuestras funciones van practicamente igual de rapido...  :o

DoEvents¡! :P

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Dessa en 13 Agosto 2010, 12:57 pm
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 ?



PsYkE1, si en teoria tenes razon, pero probando no cambia en mucho, después pruebo mejor, me quedó la cabeza "quemada"  :xD









Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Psyke1 en 13 Agosto 2010, 13:13 pm
Cita de: Dessa en 13 Agosto 2010, 12:57 pm
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 ?
:o
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  :rolleyes::
Código
  1. Option Explicit
  2. Private Declare Sub RtlMoveMemory Lib "Kernel32" (ByVal Destination As Any, ByVal Source As Any, ByVal length As Long)
  3.  
  4. Public Function Check_Lucky_Number3(ByVal lNumber As Long) As Boolean
  5.     Dim lTempArray()            As Long
  6.     Dim NextElim                As Long
  7.     Dim lArrayUBound            As Long
  8.     Dim m                       As Long
  9.     Dim x                       As Long
  10.  
  11.     If lNumber = 1 Or lNumber = 3 Then
  12.         GoTo IsLucky
  13.     ElseIf (lNumber > 1) And (lNumber Mod 2 <> 0) Then
  14.         m = 1
  15.         For x = 1 To lNumber Step 2
  16.             ReDim Preserve lTempArray(m)
  17.             lTempArray(m) = x
  18.             m = m + 1
  19.         Next
  20.         NextElim = 3: m = 2
  21.         Do
  22.             x = NextElim
  23.             Do While x <= UBound(lTempArray)
  24.                 lArrayUBound = UBound(lTempArray)
  25.                 If Not x = lArrayUBound Then
  26.                     RtlMoveMemory VarPtr(lTempArray(x)), VarPtr(lTempArray(x + 1)), (lArrayUBound - x) * 4
  27.                     ReDim Preserve lTempArray(lArrayUBound - 1)
  28.                 Else
  29.                     Exit Function
  30.                 End If
  31.                 x = x + (NextElim - 1)
  32.             Loop
  33.             m = m + 1
  34.             NextElim = lTempArray(m)
  35.         Loop While Not NextElim > lArrayUBound
  36. IsLucky: Check_Lucky_Number3 = True
  37.     End If
  38. End Function

Testeado con GetTickCount:
Citar
LeandroA IsLuckyNumber ---> 125
PsyKe1 Check_Lucky_Number3 ---> 125
:¬¬ :xD


@Dessa
Me referia a que hicieses algo asi:
Código
  1. Option Explicit
  2.  
  3. Function IsLucky2(lngNum As Long) As Boolean
  4.     Dim x As Long, cont As Long, contStep As Long, Indice As Long, numLuck() As String
  5.  
  6.     If lngNum < 1 Or lngNum Mod 2 = 0 Or lngNum = 5 Then Exit Function
  7.     If lngNum = 1 Or lngNum = 3 Then IsLucky2 = True: Exit Function
  8.  
  9.     For x = 1 To lngNum Step 2
  10.           ReDim Preserve numLuck(contStep)
  11.           numLuck(contStep) = x
  12.           contStep = contStep + 1
  13.     Next
  14.     contStep = 0: cont = 0: Indice = 1
  15.     While numLuck(Indice) <= UBound(numLuck)
  16.       For x = 0 To UBound(numLuck)
  17.           If cont = numLuck(Indice) - 1 Then
  18.             cont = 0
  19.           Else
  20.             numLuck(contStep) = numLuck(x)
  21.             cont = cont + 1
  22.             contStep = contStep + 1
  23.           End If
  24.       Next
  25.       If contStep = numLuck(Indice + 1) Then ReDim Preserve numLuck(contStep - 2) Else ReDim Preserve numLuck(contStep - 1)
  26.       If numLuck(UBound(numLuck)) <> lngNum Then Exit Function
  27.       cont = 0
  28.       contStep = 0
  29.       Indice = Indice + 1
  30.     Wend
  31.  
  32.     IsLucky2 = True
  33. End Function

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


@Karcrack
Una duda con tu code:
Código
  1. If (lNumb And 1 = 0) Then Exit Function
Esto para que es?¿  :huh:
Es como hacer Mod?¿

DoEvents¡! :P

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Karcrack en 13 Agosto 2010, 22:01 pm
Puff, me descuido un dia y me dejais completamente atras :-[, ya os descuidareis y despertare a todas mis neuronas muahahahhaha! >:D :xD

@Psyke: Es para comprobar que sea par, es muchiiiisimo mas rapido que hacer un Mod, es lo que te dije, trabajar con Bits :P

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Tokes en 13 Agosto 2010, 22:22 pm
Hola a todos:

No pude evitar hacer un código después de ver el ímpetu que demuestran.

Hice un código que recibe un número y despliega un mensaje, informando si ese número es o no es de la suerte. El mensaje también muestra el tiempo transcurrido en realizar las operaciones; muestra el tiempo antes de iniciar las operaciones, el tiempo después de realizar las operaciones y por último, la diferencia entre ambos, es decir, el tiempo total empleado en realizar las operaciones.

Sólo lo probé con los números del 1 al 37, ya que me dió flojera probar con más números.

Pero bueno, se necesita un cuadro de texto Text1 y un botón de comando Command1. El código es el siguiente:


Option Explicit

Private Sub Command1_Click()
Dim esdesuerte As Boolean
Dim t1 As Long, t2 As Long, tdif As Long
    t1 = timeGetTime()
    esdesuerte = verifnum(Val(Text1.Text))
    t2 = timeGetTime()
    tdif = t2 - t1
    If esdesuerte = False Then
        MsgBox ("El número " & Val(Text1.Text) & " no es de la suerte" _
        & Chr(13) & "t1 = " & t1 & Chr(13) & "t2 = " & t2 & Chr(13) _
        & "Tiempo = " & tdif)
    Else
        MsgBox ("El número " & Val(Text1.Text) & " es de la suerte" _
        & Chr(13) & "t1 = " & t1 & Chr(13) & "t2 = " & t2 & Chr(13) _
        & "Tiempo = " & tdif)
    End If
End Sub

Private Function verifnum(ByVal num As Long) As Boolean
Dim bufA(33000) As Long
Dim bufB(33000) As Long
Dim indElim As Long
Dim iniciales As Long
Dim i As Long
Dim i_auxA As Long
Dim i_auxB As Long
   
    If num Mod 2 = 0 Then
        verifnum = False
        Exit Function
    End If
   
    indElim = 2
    iniciales = 1
    i = 1
    Do While iniciales <= num
        bufA(i) = iniciales
        iniciales = iniciales + 2
        i = i + 1
    Loop
    i = i - 1
   
    If indElim >= i Then
        verifnum = True
    Else
        Do
            indElim = bufA(indElim)
            If indElim > i Then
                verifnum = True
                Exit Function
            End If
            i_auxA = indElim
            While i_auxA <= i
                If bufA(i_auxA) = num Then
                    verifnum = False
                    Exit Function
                End If
                bufA(i_auxA) = bufA(i_auxA) * -1
                i_auxA = i_auxA + indElim
            Wend
       
            i_auxA = 1
            i_auxB = 1
            While i_auxA <= i
                If bufA(i_auxA) > 0 Then
                    bufB(i_auxB) = bufA(i_auxA)
                    i_auxB = i_auxB + 1
                End If
                i_auxA = i_auxA + 1
            Wend
            i = i_auxB - 1
       
            indElim = bufB(indElim)
            If indElim > i Then
                verifnum = True
                Exit Function
            End If
            i_auxB = indElim
            While i_auxB <= i
                If bufB(i_auxB) = num Then
                    verifnum = False
                    Exit Function
                End If
                bufB(i_auxB) = bufB(i_auxB) * -1
                i_auxB = i_auxB + indElim
            Wend
           
            i_auxA = 1
            i_auxB = 1
            While i_auxB <= i
                If bufB(i_auxB) > 0 Then
                    bufA(i_auxA) = bufB(i_auxB)
                    i_auxA = i_auxA + 1
                End If
                i_auxB = i_auxB + 1
            Wend
            i = i_auxA - 1
        Loop
    End If
End Function


Y en el módulo el código es el siguiente:


Option Explicit

Public Declare Function timeGetTime Lib "winmm.dll" () As Long

En fín, si alguien quiere hacerme el favor de revisarlo  para números arriba del 37 se los agradeceré. Es que es demasiado fastidioso estar generando a mano los números de la suerte.

                    Saludos

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Psyke1 en 14 Agosto 2010, 00:55 am
Cita de: Karcrack en 13 Agosto 2010, 22:01 pm
Puff, me descuido un dia y me dejais completamente atras :-[, ya os descuidareis y despertare a todas mis neuronas muahahahhaha! >:D :xD

@Psyke: Es para comprobar que sea par, es muchiiiisimo mas rapido que hacer un Mod, es lo que te dije, trabajar con Bits :P
Jajajajaja :laugh:
Tengo ganas de ver tu nueva version, pero espero que no quedemos todos empate... :¬¬ :silbar: :xD
@Tokes

No te ofendas, pero tu codigo esta bastante desorganizado, pon el codigo entre
[ code=vb ] aqui tu codigo [ /code ] 'Sin espacios
El code es demasiado largo y lento... :-\
Citar
Código:
Dim bufA(33000) As Long
Dim bufB(33000) As Long
o_O
Aún asi creo que te esforzaste... ;)

DoEvents¡! :P

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Dessa en 14 Agosto 2010, 01:27 am
Si Pyske1   , te entendí pero probé 45235 (compilado), con gettickcount y las dos van parejas... por supuesto que tendría que ser mas rapida con tu sugerencia (sin el último For). intentaré mejorar con RtlMoveMemory  :D



Cita de: Tokes en 13 Agosto 2010, 22:22 pm
En fín, si alguien quiere hacerme el favor de revisarlo  para números arriba del 37 se los agradeceré.

Tokes, el 45 lo da como true y no lo es, tambien entre 1 y 200 hay 8 numeros mas que no son Lucky, saludos







    

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Psyke1 en 14 Agosto 2010, 01:48 am
@Dessa
Creo que ya se por que no hay apenas diferencia:
Al utilizar tu metodo para contar el tiempo solo tienes que realizar una comprobacion, pero probandolo de esta otra manera (http://foro.elhacker.net/programacion_visual_basic/reto_comprobar_si_un_numero_dado_es_un_numero_de_la_suerte-t301960.0.html;msg1497950#msg1497950) si que se nota la diferencia porque tiene que hacer 500 comprobaciones... :rolleyes:
Lo ideal es probar la funcion de las dos maneras... ;)


@Karcrack

Código
  1. Private Sub Form_Load()
  2.     Dim x As Long
  3.     For x = 0 To 10000
  4.         If (x And 1 = 0) Then MsgBox "Funciona"
  5.     Next
  6. End Sub
:silbar:

DoEvents¡! :P

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Tokes en 14 Agosto 2010, 02:55 am
Bueno, he hecho una pequeña correción en el código y queda así. Me parece que ahora si da los números bien y es un poquitín más rápido.

Se necesitan 2 command buttons (Command1 y Command2) y textbox Text1 y una label Label1. El Command1 dice si el número del Text1 es de la suerte. El command2 da los números de la suerte desde el 1 hasta el especificado en Text1.

La Label1 debe ser un tantito grande para que le quepan todos los números.
La función que verifica si el número es de la suerte se llama verifnum.

Código:
Option Explicit

Private Sub Command1_Click()
Dim esdesuerte As Boolean
Dim t1 As Long, t2 As Long, tdif As Long
    t1 = timeGetTime()
    esdesuerte = IsLucky2(Val(Text1.Text))
    t2 = timeGetTime()
    tdif = t2 - t1
    If esdesuerte = False Then
        MsgBox ("El número " & Val(Text1.Text) & " no es de la suerte" _
        & Chr(13) & "t1 = " & t1 & Chr(13) & "t2 = " & t2 & Chr(13) _
        & "Tiempo = " & tdif)
    Else
        MsgBox ("El número " & Val(Text1.Text) & " es de la suerte" _
        & Chr(13) & "t1 = " & t1 & Chr(13) & "t2 = " & t2 & Chr(13) _
        & "Tiempo = " & tdif)
    End If
End Sub

Private Function verifnum(ByVal num As Long) As Boolean
Dim bufA() As Long
Dim bufB() As Long
Dim indElim As Long
Dim ordenElim As Long
Dim iniciales As Long
Dim i As Long
Dim i_auxA As Long
Dim i_auxB As Long


    If (num And 1) = 0 Then
        verifnum = False
        Exit Function
    End If
    
    ReDim bufA(0 To num)
    ReDim bufB(0 To num)
    ordenElim = 2
    iniciales = 1
    i = 1
    Do While iniciales <= num
        bufA(i) = iniciales
        iniciales = iniciales + 2
        i = i + 1
    Loop
    i = i - 1
    
        Do
            If ordenElim >= i Then
                verifnum = True
                Exit Function
            End If
            indElim = bufA(ordenElim)
            ordenElim = ordenElim + 1
            i_auxA = indElim
            While i_auxA <= i
                If bufA(i_auxA) = num Then
                    verifnum = False
                    Exit Function
                End If
                bufA(i_auxA) = 0
                i_auxA = i_auxA + indElim
            Wend
        
            i_auxA = 1
            i_auxB = 1
            While i_auxA <= i
                If bufA(i_auxA) > 0 Then
                    bufB(i_auxB) = bufA(i_auxA)
                    i_auxB = i_auxB + 1
                End If
                i_auxA = i_auxA + 1
            Wend
            i = i_auxB - 1
        
            If ordenElim >= i Then
                verifnum = True
                Exit Function
            End If
            indElim = bufB(ordenElim)
            ordenElim = ordenElim + 1
            i_auxB = indElim
            While i_auxB <= i
                If bufB(i_auxB) = num Then
                    verifnum = False
                    Exit Function
                End If
                bufB(i_auxB) = 0
                i_auxB = i_auxB + indElim
            Wend
            
            i_auxA = 1
            i_auxB = 1
            While i_auxB <= i
                If bufB(i_auxB) > 0 Then
                    bufA(i_auxA) = bufB(i_auxB)
                    i_auxA = i_auxA + 1
                End If
                i_auxB = i_auxB + 1
            Wend
            i = i_auxA - 1
        Loop
    'End If
End Function

Private Sub Command2_Click()
Dim strvis As String
Dim i As Long
Dim t1 As Long, t2 As Long
    t1 = timeGetTime
    strvis = "Los números de la suerte entre el 1 y el " & Text1.Text & " son:" & Chr(13)
    If verifnum(1) = True Then
        strvis = strvis & CStr(1)
    End If
    For i = 2 To Text1.Text
        If verifnum(i) = True Then
            strvis = strvis & ", " & Str(i)
        End If
    Next i
    t2 = timeGetTime
    strvis = strvis & Chr(13) & "Tiempo = " & t2 - t1
    'MsgBox (strvis)
    Label1 = strvis
End Sub

Y el código del módulo es:

Código:
Option Explicit

Public Declare Function timeGetTime Lib "winmm.dll" () As Long

Bueno, el código es un poco largo pero me parece que va un poquitín más rápido.

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: cobein en 14 Agosto 2010, 09:47 am
Ahi va mi aporte, perdon por la descarga pero es un poco grande para pegar aca.
Posiblemente no sea tan rapido como otros que vi por aca porque priorice el uso de memoria (simplemente por gusto) en vez de utilizar un array de longs como vi que usaban muchos me parecio mas entretenido hacer algo diferente, asi que utilice un array de bytes que a su vez los utilizo como array de bits para guardar 8 valores por byte, lo malo de hacerlo de esta manera es que hay que recorrer el array para encontrar los indices pero trate de optimizarlo un poco, por ejemplo el loop principal utiliza un tercio de las iteraciones que vi que los demas utilizan y otras cositas mas.

[http://cobein.com/shares/LuckyNumbs.rar]

Edit: Me olvide de quitar un pedazo de codigo que estaba utilizando... nada importante pero aca pego uno mas limpio.

Código:
Private Function TestNum(ByVal lVal As Long) As Boolean
    
    If lVal < 1 Then Exit Function
    If Not lVal And 1 Then Exit Function
    
    mBitArray.AllocateBuffer lVal
    
    Dim i As Long
    For i = 1 To lVal Step 6
        mBitArray.SetValue i, True
        mBitArray.SetValue i + 2, True
    Next
    
    Dim lIncrement As Long
    Dim lPos As Long
    
    lPos = 3
    Dim lRet As Long
    
    Do
        lIncrement = mBitArray.FindPositive(lPos)
        If lIncrement = -1 Then Exit Do
        lRet = 1
        Do
            lRet = mBitArray.FindPositive(lIncrement, lRet) 'Save the last pos to not loop from start
            If lRet = -1 Then Exit Do
            mBitArray.SetValue lRet, False
        Loop
        If Not FindPositiveRev(1) = lVal Then Exit Function
        lPos = lPos + 1
    Loop
    If FindPositiveRev(1) = lVal Then TestNum = True
        
End Function

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Angeldj27 en 14 Agosto 2010, 18:47 pm
No se si es una forma chapucera de hacerlo pero asi de una forma rapido fue k se me ocurrio con arrays se k ess mas facil con los collection pero esa es la norma con los arrays pense k con un par de arrays anidados se podia como hice algo en la escuela una vez pero no tenia vastante tiempo haci k esta es la forma mas facil k pude hacerlo pork no tengo destrezas con usar datos en memoria jeje

Código
  1. Public Function LuckyNumber(ByVal N As Long) As Boolean
  2.         Dim ANumero()    As Long
  3.         Dim AText1()       As Long
  4.         Dim i                   As Integer
  5.         Dim X                  As Integer        
  6.  
  7.         i = 1
  8.         X = 1
  9.         If N Mod 2 = 0 Then Exit Function  
  10.  
  11.         For i = 1 To N Step 2
  12.            ANumero(X) = i
  13.            X = X + 1
  14.         Next
  15.         For i = 0 To UBound(ANumero) Step 3
  16.             If ANumero(i) = N Then Exit Function
  17.             ANumero(i) = 0
  18.         Next
  19.         X = 1
  20.         For i = 1 To UBound(ANumero)
  21.              If ANumero(i) <> 0 Then
  22.                 AText1(X) = ANumero(i)
  23.                 X = X + 1
  24.              End If
  25.         Next
  26.         For i = 0 To UBound(AText1) Step 7
  27.             If AText1(i) = N Then Exit Function            
  28.         Next
  29.  
  30.         LuckyNumber = True
  31.  
  32. End Function


No se si es muy rapida pero funciona bien  ;D


Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Psyke1 en 14 Agosto 2010, 19:33 pm
@Angeldj27
No funciona bien me da varios errores en las matrices, y solo haces tres bucles para quitar numeros el resultado no sera correcto, leete bien el link que puso karcrack al principio... ;)

DoEvents¡! :P

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Dessa en 14 Agosto 2010, 22:28 pm
Pude mejorar en parte a mi primera version, bueno, algo es algo...

Tambien me queda pendiente la sugerencia de Psyke.
 

Código:

Option Explicit
Private Declare Function GetTickCount Lib "Kernel32" () As Long

Private Sub Form_Load()
  
  If App.LogMode = 0 Then
    MsgBox "Ejecutar Compilado"
    End ' perdon por el end
  End If
  
    Dim t1 As Long
    Dim t2 As Long
  
    Me.AutoRedraw = True
    
    t1 = GetTickCount
    Me.Print IsLucky(45235) & "  IsLucky"
    t2 = GetTickCount
    Me.Print t2 - t1
 
End Sub
Function IsLucky(lngNum As Long) As Boolean
 
 Dim x As Long, cont As Long, contStep As Long, Indice As Long, 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
 If lngNum = 5 Then 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)
     If numLuck(UBound(numLuck)) <> lngNum Then Exit Function
     x = -1
     While x < UBound(numLuck)
         x = x + 1
         If cont = numLuck(Indice) - 1 Then
             cont = 0
         Else
           numLuck(contStep) = numLuck(x)
           cont = cont + 1
           contStep = contStep + 1
         End If
   Wend
 
   If contStep = numLuck(Indice + 1) Then
       ReDim Preserve numLuck(contStep - 2)
   Else
       ReDim Preserve numLuck(contStep - 1)
   End If
   cont = 0
   contStep = 0
   Indice = Indice + 1
 Wend
 
 For x = 0 To UBound(numLuck)
   If numLuck(x) = lngNum Then
     IsLucky = True
     Exit For
   End If
 Next
 
End Function






Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Tokes en 15 Agosto 2010, 00:21 am
Señores, he corregido mi código. Finalmente pude hacer la función un tanto más compacta y más rápida que la primera y la segunda versión que hice. Les dejo el código (la función se llama verifnum3 porque es el tercer intento que hice):

Código:
Private Function verifnum3(ByVal num As Long) As Boolean
Dim bufA() As Long
Dim indElim As Long
Dim indElim_aux As Long
Dim ordenElim As Long
Dim iniciales 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
    
    ReDim bufA(0 To num)
    ReDim bufB(0 To num)
    ordenElim = 2
    iniciales = 1
    i = 1
    Do While iniciales <= num
        bufA(i) = iniciales
        iniciales = iniciales + 2
        i = i + 1
    Loop
    i = i - 1
    
    If ordenElim >= i Then
        verifnum3 = True
        Exit Function
    End If
        
    Do
        indElim = bufA(ordenElim)
        ordenElim = ordenElim + 1
        If indElim > i Then
            verifnum3 = True
            Exit Function
        End If
        If bufA(indElim) = num Then Exit Function
        i_auxA = indElim
        i_auxB = indElim + 1
        Do
            For indElim_aux = 2 To indElim
                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
    Loop
End Function

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Angeldj27 en 15 Agosto 2010, 01:08 am
Cita de: *PsYkE1* en 14 Agosto 2010, 19:33 pm
@Angeldj27
No funciona bien me da varios errores en las matrices, y solo haces tres bucles para quitar numeros el resultado no sera correcto, leete bien el link que puso karcrack al principio... ;)

DoEvents¡! :P

Talvez hay que definirle un numero fijo a la dimencion del array o matrix pero es raro me funciona bien y con lo k dices, voy eliminando numeros como dice el link de karcrack y chekeo la matriz y si el numero no esta hay se supone k no es numero de la suerte es simple logica ami me funciona de 10

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Psyke1 en 15 Agosto 2010, 01:36 am
Mira, te pongo un ejemplo:
Código
  1.   Dim x As Long
  2.   Dim s As String
  3.   For x = 5000 To 5500
  4.     'If Check_Lucky_Number3(x) Then
  5.     If LuckyNumber(x) Then
  6.         s = s & x & " "
  7.     End If
  8.   Next
  9.   Debug.Print s
Me devuelve:
Citar
5001 5005 5007 5011 5013 5019 5023 5025 5029 5031 5035 5041 5043 5047 5049 5053 5055 5061 5065 5067 5071 5073 5077 5083 5085 5089 5091 5095 5097 5103 5107 5109 5113 5115 5119 5125 5127 5131 5133 5137 5139 5145 5149 5151 5155 5157 5161 5167 5169 5173 5175 5179 5181 5187 5191 5193 5197 5199 5203 5209 5211 5215 5217 5221 5223 5229 5233 5235 5239 5241 5245 5251 5253 5257 5259 5263 5265 5271 5275 5277 5281 5283 5287 5293 5295 5299 5301 5305 5307 5313 5317 5319 5323 5325 5329 5335 5337 5341 5343 5347 5349 5355 5359 5361 5365 5367 5371 5377 5379 5383 5385 5389 5391 5397 5401 5403 5407 5409 5413 5419 5421 5425 5427 5431 5433 5439 5443 5445 5449 5451 5455 5461 5463 5467 5469 5473 5475 5481 5485 5487 5491 5493 5497
Cuando deberia devolver:
Citar
5001 5007 5019 5029 5041 5043 5049 5053 5089 5103 5127 5137 5139 5149 5151 5157 5169 5179 5181 5191 5211 5217 5229 5233 5235 5253 5259 5277 5283 5293 5295 5299 5325 5335 5341 5343 5371 5377 5379 5385 5409 5419 5427 5433 5449 5455 5463 5473 5487 5491

@Dessa
No pense que fuera a cambiar tanto el resultado... :o
Ahora pruebalo asi:
Código
  1. Private Sub Form_Load()
  2.     Dim x As Long
  3.     Dim s As String
  4.     Dim t1 As Long
  5.     Dim t2 As Long
  6.  
  7.     If App.LogMode = 0 Then End
  8.     Me.AutoRedraw = True
  9.  
  10.     'Dessa
  11.     Me.Print "Dessa"
  12.     t1 = GetTickCount
  13.     For x = 5000 To 7000
  14.         If IsLucky(x) Then
  15.             s = s & x & " "
  16.         End If
  17.     Next
  18.     t2 = GetTickCount
  19.     Me.Print t2 - t1 & vbNewLine
  20.  
  21.     MsgBox s
  22.     s = ""
  23.  
  24.     '*PsYkE1*
  25.     Me.Print "PsYkE1"
  26.     t1 = GetTickCount
  27.     For x = 5000 To 7000
  28.         If Check_Lucky_Number3(x) Then
  29.             s = s & x & " "
  30.         End If
  31.     Next
  32.     t2 = GetTickCount
  33.     Me.Print t2 - t1 & vbNewLine
  34.     MsgBox s
  35.  
  36.     'LeandroA
  37.     Me.Print "LeandroA"
  38.     t1 = GetTickCount
  39.     For x = 5000 To 7000
  40.         If IsLuckyNumber(x) Then
  41.             s = s & x & " "
  42.         End If
  43.     Next
  44.     t2 = GetTickCount
  45.     Me.Print t2 - t1
  46.     MsgBox s
  47. End Sub

Mis resultados:

Dessa          2265
*PsYkE1*   1860
LeandroA    1984

 :rolleyes:

DoEvents¡! :P

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: LeandroA en 15 Agosto 2010, 05:12 am
mmm me parece que estas tomando mal mi función yo tengo estos resultados

Dessa
2125

PsYkE1
2000

LeandroA
1172

pongo las tres funciones
Código
  1.  
  2. Option Explicit
  3. Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal length As Long)
  4. Private Declare Sub RtlMoveMemory Lib "Kernel32" (ByVal Destination As Any, ByVal Source As Any, ByVal length As Long)
  5. Private Declare Function GetTickCount Lib "Kernel32" () As Long
  6.  
  7. Private Sub Form_Load()
  8.     Dim x As Long
  9.     Dim s As String
  10.     Dim t1 As Long
  11.     Dim t2 As Long
  12.  
  13.     If App.LogMode = 0 Then End
  14.     Me.AutoRedraw = True
  15.  
  16.     'Dessa
  17.     Me.Print "Dessa"
  18.     t1 = GetTickCount
  19.     For x = 5000 To 7000
  20.         If IsLucky(x) Then
  21.             s = s & x & " "
  22.         End If
  23.     Next
  24.     t2 = GetTickCount
  25.     Me.Print t2 - t1 & vbNewLine
  26.  
  27.     MsgBox s
  28.     s = ""
  29.  
  30.     '*PsYkE1*
  31.     Me.Print "PsYkE1"
  32.     t1 = GetTickCount
  33.     For x = 5000 To 7000
  34.         If Check_Lucky_Number3(x) Then
  35.             s = s & x & " "
  36.         End If
  37.     Next
  38.     t2 = GetTickCount
  39.     Me.Print t2 - t1 & vbNewLine
  40.     MsgBox s
  41.  
  42.     'LeandroA
  43.     Me.Print "LeandroA"
  44.     t1 = GetTickCount
  45.     For x = 5000 To 7000
  46.         If IsLuckyNumber(x) Then
  47.             s = s & x & " "
  48.         End If
  49.     Next
  50.     t2 = GetTickCount
  51.     Me.Print t2 - t1
  52.     MsgBox s
  53. End Sub
  54.  
  55. 'Dessa
  56. Function IsLucky(lngNum As Long) As Boolean
  57.  
  58.   Dim x As Long, cont As Long, contStep As Long, Indice As Long, numLuck() As Long
  59.  
  60.   If lngNum < 1 Then Exit Function
  61.   If lngNum Mod 2 = 0 Then Exit Function
  62.   If lngNum = 1 Or lngNum = 3 Then IsLucky = True: Exit Function
  63.   If lngNum = 5 Then Exit Function
  64.  
  65.  
  66.   For x = 1 To lngNum Step 2
  67.       ReDim Preserve numLuck(contStep)
  68.       numLuck(contStep) = x
  69.       contStep = contStep + 1
  70.   Next
  71.  
  72.   contStep = 0: cont = 0: Indice = 1
  73.  
  74.   While numLuck(Indice) <= UBound(numLuck)
  75.       x = -1
  76.       While x < UBound(numLuck)
  77.           x = x + 1
  78.           If cont = numLuck(Indice) - 1 Then
  79.               cont = 0
  80.           Else
  81.             numLuck(contStep) = numLuck(x)
  82.             cont = cont + 1
  83.             contStep = contStep + 1
  84.           End If
  85.     Wend
  86.  
  87.     If contStep = numLuck(Indice + 1) Then
  88.         ReDim Preserve numLuck(contStep - 2)
  89.     Else
  90.         ReDim Preserve numLuck(contStep - 1)
  91.     End If
  92.     cont = 0
  93.     contStep = 0
  94.     Indice = Indice + 1
  95.   Wend
  96.  
  97.   For x = 0 To UBound(numLuck)
  98.     If numLuck(x) = lngNum Then
  99.       IsLucky = True
  100.       Exit For
  101.     End If
  102.   Next
  103.  
  104. End Function
  105.  
  106.  
  107.  
  108.  
  109. '-PsYkE1
  110. Public Function Check_Lucky_Number3(ByVal lNumber As Long) As Boolean
  111.     Dim lTempArray()            As Long
  112.     Dim NextElim                As Long
  113.     Dim lArrayUBound            As Long
  114.     Dim m                       As Long
  115.     Dim x                       As Long
  116.  
  117.     If lNumber = 1 Or lNumber = 3 Then
  118.         GoTo IsLucky
  119.     ElseIf (lNumber > 1) And (lNumber Mod 2 <> 0) Then
  120.         m = 1
  121.         For x = 1 To lNumber Step 2
  122.             ReDim Preserve lTempArray(m)
  123.             lTempArray(m) = x
  124.             m = m + 1
  125.         Next
  126.         NextElim = 3: m = 2
  127.         Do
  128.             x = NextElim
  129.             Do While x <= UBound(lTempArray)
  130.                 lArrayUBound = UBound(lTempArray)
  131.                 If Not x = lArrayUBound Then
  132.                     RtlMoveMemory VarPtr(lTempArray(x)), VarPtr(lTempArray(x + 1)), (lArrayUBound - x) * 4
  133.                     ReDim Preserve lTempArray(lArrayUBound - 1)
  134.                 Else
  135.                     Exit Function
  136.                 End If
  137.                 x = x + (NextElim - 1)
  138.             Loop
  139.             m = m + 1
  140.             NextElim = lTempArray(m)
  141.         Loop While Not NextElim > lArrayUBound
  142. IsLucky: Check_Lucky_Number3 = True
  143.     End If
  144. End Function
  145.  
  146. 'LeandroA
  147. Private Function IsLuckyNumber(ByVal Num As Long) As Boolean
  148.  
  149.     Dim lCount As Long, lPos As Long, i As Long
  150.     Dim Arr() As Long
  151.  
  152.     If Num < 1 Then Exit Function
  153.     If Num Mod 2 = 0 Then Exit Function
  154.  
  155.     ReDim Preserve Arr(CLng(Num / 2) + (Num Mod 2))
  156.  
  157.     For lPos = 1 To Num Step 2
  158.          i = i + 1
  159.          Arr(i) = lPos
  160.     Next
  161.  
  162.  
  163.     lCount = 1
  164.  
  165.     Do While UBound(Arr) > lCount
  166.  
  167.         lCount = lCount + 1
  168.         lPos = Arr(lCount)
  169.  
  170.         Do
  171.             If lPos > UBound(Arr) Then Exit Do
  172.             If lPos < UBound(Arr) Then CopyMemory Arr(lPos), Arr(lPos + 1), 4 * (UBound(Arr) - lPos)
  173.             ReDim Preserve Arr(UBound(Arr) - 1)
  174.             lPos = lPos + Arr(lCount) - 1
  175.         Loop
  176.  
  177.         If Arr(UBound(Arr)) <> Num Then Exit Function
  178.     Loop
  179.  
  180.     IsLuckyNumber = True
  181.  
  182. End Function
  183.  

Saludos

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: BlackZeroX en 15 Agosto 2010, 07:28 am

LA de cobein aun se esta ejecutando, en un siguiente Post pongo el resultado con el de este por que su funcion es ESAGERADAMENTE LENTA ( me tardo 1 minuto, actualmente se esta combrobando las coherencias. )!¡.

No se por que demonios pero por hay creo que Spyke y Dessa andan mal o quisas sea Leandro?

Lo siguiente comprueba Tiempo y coherencias entre las tres funciones, LeandroA difiere con Spyke y Dessa en algunos numeros, aqui mostrados!¡.

Código:

Dessa --> 2625
PsYkE1 -- > 2094
LeandroA -- > 1359

Se comprobaran Coherencias...

LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 5179
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 5191
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 5299
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 5335
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 5371
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 5419
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 5455
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 5491
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 5503
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 5515
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 5527
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 5551
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 5587
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 5599
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 5671
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 5707
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 5719
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 5755
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 5767
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 5803
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 5827
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 5839
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 5851
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 5911
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 5923
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 5959
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 5971
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 6019
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 6031
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 6055
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 6079
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 6115
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 6163
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 6175
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 6211
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 6271
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 6331
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 6355
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 6367
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 6379
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 6415
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 6427
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 6463
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 6475
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 6523
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 6535
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 6559
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 6631
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 6667
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 6679
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 6715
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 6763
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 6787
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 6871
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 6883
LeandroA (Falso) ;  Dessa (Verdadero) ;   PsYkE1 (Verdadero)   --> 6931


Dulces Lunas!¡.

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: BlackZeroX en 15 Agosto 2010, 07:33 am

Aqui el proyecto de comprobacion!¡.

http://infrangelux.sytes.net/filex/down.php?InfraDown=/BlackZeroX/ComprobacionVel.zip


Código:


Dessa --> 2625
PsYkE1 -- > 2078
LeandroA -- > 1375
Cobein -- > 108015

Se comprobaran Coherencias...

LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 5179
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 5191
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 5299
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 5335
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 5371
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 5419
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 5455
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 5491
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 5503
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 5515
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 5527
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 5551
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 5587
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 5599
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 5671
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 5707
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 5719
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 5755
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 5767
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 5803
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 5827
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 5839
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 5851
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 5911
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 5923
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 5959
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 5971
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 6019
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 6031
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 6055
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 6079
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 6115
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 6163
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 6175
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 6211
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 6271
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 6331
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 6355
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 6367
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 6379
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 6415
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 6427
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 6463
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 6475
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 6523
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 6535
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 6559
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 6631
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 6667
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 6679
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 6715
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 6763
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 6787
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 6871
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 6883
LeandroA (Falso) ;   Dessa (Verdadero) ;   PsYkE1 (Verdadero) ;   Cobein (Verdadero) ; --> 6931


Dulces Lunas!¡.

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Dessa en 15 Agosto 2010, 07:48 am
Yo olvidé de agregar un If a mi code, luego pruebo como dice  BlackZeroX , por ahora serà así

Código:

Option Explicit
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal length As Long)
Private Declare Sub RtlMoveMemory Lib "Kernel32" (ByVal Destination As Any, ByVal Source As Any, ByVal length As Long)
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 End
   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
   s = ""
 
   '*PsYkE1*
   Me.Print "PsYkE1"
   t1 = GetTickCount
   For x = 5000 To 7000
       If Check_Lucky_Number3(x) Then
           s = s & x & " "
       End If
   Next
   t2 = GetTickCount
   Me.Print t2 - t1 & vbNewLine
   MsgBox s
 
   'LeandroA
   Me.Print "LeandroA"
   t1 = GetTickCount
   For x = 5000 To 7000
       If IsLuckyNumber(x) Then
           s = s & x & " "
       End If
   Next
   t2 = GetTickCount
   Me.Print t2 - t1
   MsgBox s
End Sub
 
'Dessa
Function IsLucky(lngNum As Long) As Boolean
 
 Dim x As Long, cont As Long, contStep As Long, Indice As Long, 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
 If lngNum = 5 Then 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)
     If numLuck(UBound(numLuck)) <> lngNum Then Exit Function
     x = -1
     While x < UBound(numLuck)
         x = x + 1
         If cont = numLuck(Indice) - 1 Then
             cont = 0
         Else
           numLuck(contStep) = numLuck(x)
           cont = cont + 1
           contStep = contStep + 1
         End If
   Wend
 
   If contStep = numLuck(Indice + 1) Then
       ReDim Preserve numLuck(contStep - 2)
   Else
       ReDim Preserve numLuck(contStep - 1)
   End If
   cont = 0
   contStep = 0
   Indice = Indice + 1
 Wend
 
 For x = 0 To UBound(numLuck)
   If numLuck(x) = lngNum Then
     IsLucky = True
     Exit For
   End If
 Next
 
End Function
 
 
 
 
'-PsYkE1
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
 
'LeandroA
Private Function IsLuckyNumber(ByVal Num As Long) As Boolean
 
   Dim lCount As Long, lPos As Long, i As Long
   Dim Arr() As Long
 
   If Num < 1 Then Exit Function
   If Num Mod 2 = 0 Then Exit Function
 
   ReDim Preserve Arr(CLng(Num / 2) + (Num Mod 2))
 
   For lPos = 1 To Num Step 2
        i = i + 1
        Arr(i) = lPos
   Next
 
 
   lCount = 1
 
   Do While UBound(Arr) > lCount
 
       lCount = lCount + 1
       lPos = Arr(lCount)
 
       Do
           If lPos > UBound(Arr) Then Exit Do
           If lPos < UBound(Arr) Then CopyMemory Arr(lPos), Arr(lPos + 1), 4 * (UBound(Arr) - lPos)
           ReDim Preserve Arr(UBound(Arr) - 1)
           lPos = lPos + Arr(lCount) - 1
       Loop
 
       If Arr(UBound(Arr)) <> Num Then Exit Function
   Loop
 
   IsLuckyNumber = True
 
End Function





Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Psyke1 en 15 Agosto 2010, 11:00 am
Citar
mmm me parece que estas tomando mal mi función yo tengo estos resultados
Cierto, disculpame... :-\
Se me olvido poner esto en tu funcion: http://foro.elhacker.net/programacion_visual_basic/reto_comprobar_si_un_numero_dado_es_un_numero_de_la_suerte-t301960.0.html;msg1498223#msg1498223

@BlackZer0x
Gracias por realizar la comprobacion ;)

DoEvents¡! :P

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Tokes en 15 Agosto 2010, 18:27 pm
Oigan, aquí les dejo mi cuarto intento junto con sus funciones.

Código:
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal length As Long)
Private Declare Sub RtlMoveMemory Lib "Kernel32" (ByVal Destination As Any, ByVal Source As Any, ByVal length As Long)
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 End
   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 = ""
 
   '*PsYkE1*
   Me.Print "PsYkE1"
   t1 = GetTickCount
   For x = 5000 To 7000
       If Check_Lucky_Number3(x) Then
           s = s & x & " "
       End If
   Next
   t2 = GetTickCount
   Me.Print t2 - t1 & vbNewLine
   MsgBox s, vbOKOnly, "PsYkE1"
    s = ""
    
   'LeandroA
   Me.Print "LeandroA"
   t1 = GetTickCount
   For x = 5000 To 7000
       If IsLuckyNumber(x) Then
           s = s & x & " "
       End If
   Next
   t2 = GetTickCount
   Me.Print t2 - t1 & vbNewLine
   MsgBox s, vbOKOnly, "LeandroA"
   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, cont As Long, contStep As Long, Indice As Long, 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
 If lngNum = 5 Then 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)
     If numLuck(UBound(numLuck)) <> lngNum Then Exit Function
     x = -1
     While x < UBound(numLuck)
         x = x + 1
         If cont = numLuck(Indice) - 1 Then
             cont = 0
         Else
           numLuck(contStep) = numLuck(x)
           cont = cont + 1
           contStep = contStep + 1
         End If
   Wend
 
   If contStep = numLuck(Indice + 1) Then
       ReDim Preserve numLuck(contStep - 2)
   Else
       ReDim Preserve numLuck(contStep - 1)
   End If
   cont = 0
   contStep = 0
   Indice = Indice + 1
 Wend
 
 For x = 0 To UBound(numLuck)
   If numLuck(x) = lngNum Then
     IsLucky = True
     Exit For
   End If
 Next
 
End Function
 
 
 
 
'-PsYkE1
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
 
'LeandroA
Private Function IsLuckyNumber(ByVal Num As Long) As Boolean
 
   Dim lCount As Long, lPos As Long, i As Long
   Dim Arr() As Long
 
   If Num < 1 Then Exit Function
   If Num Mod 2 = 0 Then Exit Function
 
   ReDim Preserve Arr(CLng(Num / 2) + (Num Mod 2))
 
   For lPos = 1 To Num Step 2
        i = i + 1
        Arr(i) = lPos
   Next
 
 
   lCount = 1
 
   Do While UBound(Arr) > lCount
 
       lCount = lCount + 1
       lPos = Arr(lCount)
 
       Do
           If lPos > UBound(Arr) Then Exit Do
           If lPos < UBound(Arr) Then CopyMemory Arr(lPos), Arr(lPos + 1), 4 * (UBound(Arr) - lPos)
           ReDim Preserve Arr(UBound(Arr) - 1)
           lPos = lPos + Arr(lCount) - 1
       Loop
 
       If Arr(UBound(Arr)) <> Num Then Exit Function
   Loop
 
   IsLuckyNumber = 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

Mis resultados son:

Dessa --> 12859
PsYkE1 --> 5109
LeandroA --> 3438
Tokes --> 4359

            Saludos.

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Dessa en 15 Agosto 2010, 19:15 pm
@ Token, tanto tu code como el mio pierden mucho en el ide, compilado es como se debe tomar los tiempos, excelente tu  codigo (ya lo habia notado) y toma denuevo los tiempos (compilados)

Saludos

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: BlackZeroX en 15 Agosto 2010, 20:11 pm
.
Hay en la que me pario la de Tokes es mucho mas rapida ya que no usa Redim!¡, tenia planeado realizar una similar sin usar redim pero ya me ganaron  :¬¬ .

Actualize la funcion de Dessa

http://infrangelux.sytes.net/FileX/down.php?InfraDown=/BlackZeroX/Comprovaciones/NumOfLuck/ComprobacionVel%20V2.zip

Código:


Dessa --> 1187
PsYkE1 -- > 2015
LeandroA -- > 1313
Cobein -- > 105390
Tokes -- > 204

Se comprobaran Coherencias...

Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 5179
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 5191
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 5299
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 5335
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 5371
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 5419
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 5455
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 5491
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 5503
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 5515
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 5527
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 5551
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 5587
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 5599
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 5671
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 5707
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 5719
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 5755
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 5767
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 5803
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 5827
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 5839
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 5851
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 5911
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 5923
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 5959
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 5971
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 6019
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 6031
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 6055
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 6079
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 6115
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 6163
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 6175
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 6211
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 6271
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 6331
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 6355
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 6367
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 6379
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 6415
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 6427
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 6463
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 6475
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 6523
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 6535
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 6559
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 6631
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 6667
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 6679
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 6715
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 6763
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 6787
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 6871
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 6883
Dessa (Verdadero) ; PsYkE1 (Verdadero) ; LeandroA (Falso) ; Cobein (Verdadero) ; Tokes (Verdadero) ; --> 6931


Dulces Lunas¡.

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: LeandroA en 15 Agosto 2010, 20:20 pm
 :-\ me equivoque de signo / por \

Código:
ReDim Preserve Arr(Num \ 2 + (Num Mod 2))

Código
  1. Option Explicit
  2. Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
  3.  
  4. Private Function IsLuckyNumber(ByVal Num As Long) As Boolean
  5.  
  6.     Dim lCount As Long, lPos As Long, i As Long
  7.     Dim Arr() As Long
  8.  
  9.     If Num < 1 Then Exit Function
  10.     If Num Mod 2 = 0 Then Exit Function
  11.  
  12.    ReDim Preserve Arr(Num \ 2 + (Num Mod 2))
  13.  
  14.     For lPos = 1 To Num Step 2
  15.          i = i + 1
  16.          Arr(i) = lPos
  17.     Next
  18.  
  19.  
  20.     lCount = 1
  21.  
  22.     Do While UBound(Arr) > lCount
  23.  
  24.         lCount = lCount + 1
  25.         lPos = Arr(lCount)
  26.  
  27.         Do
  28.             If lPos > UBound(Arr) Then Exit Do
  29.             If lPos < UBound(Arr) Then CopyMemory Arr(lPos), Arr(lPos + 1), 4 * (UBound(Arr) - lPos)
  30.             ReDim Preserve Arr(UBound(Arr) - 1)
  31.             lPos = lPos + Arr(lCount) - 1
  32.         Loop
  33.  
  34.         If Arr(UBound(Arr)) <> Num Then Exit Function
  35.     Loop
  36.  
  37.     IsLuckyNumber = True
  38.  
  39. End Function
  40.  

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: BlackZeroX en 15 Agosto 2010, 20:31 pm
.
http://infrangelux.sytes.net/FileX/down.php?InfraDown=/BlackZeroX/Comprovaciones/NumOfLuck/ComprobacionVel-3.zip

Código:

Dessa --> 1250
PsYkE1 -- > 2078
LeandroA -- > 1453
Cobein -- > 107265
Tokes -- > 204

Se comprobaran Coherencias...


Dulces Lunas!¡.

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: LeandroA en 15 Agosto 2010, 20:34 pm
Tokes nos mato a todos jejej :D

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Psyke1 en 15 Agosto 2010, 21:52 pm
OMFG!!
Buen trabajo Tokes! ;)

DoEvents¡! :P

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Karcrack en 15 Agosto 2010, 22:38 pm
Gran trabajo Tokes :) Me has animado a sacar una version rapida, rapida, rapida... esta noche voy a esforzarme al maximo >:D :xD

Por cierto, otro buen punto de la funcion es la RAM que ocupa... En eso Cobein va en cabeza ;)

A ver si antes de las 3 tengo una version buena de verdad :)

Saludos

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: BlackZeroX en 15 Agosto 2010, 22:47 pm
La Funcion de Tokes me parece que se puede hacer mas rapida si en lgar del For Next se sustituye por CopyMemory...

Dulces Lunas!¡.

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Psyke1 en 15 Agosto 2010, 23:15 pm
Cita de: Karcrack en 15 Agosto 2010, 22:38 pm
Gran trabajo Tokes :) Me has animado a sacar una version rapida, rapida, rapida... esta noche voy a esforzarme al maximo >:D :xD

Por cierto, otro buen punto de la funcion es la RAM que ocupa... En eso Cobein va en cabeza ;)

A ver si antes de las 3 tengo una version buena de verdad :)

Saludos
Tengo ganas de ver tu nueva version, a proposito Karcrack, mira a ver si puedes responderme esto por favor:
http://foro.elhacker.net/programacion_visual_basic/reto_comprobar_si_un_numero_dado_es_un_numero_de_la_suerte-t301960.0.html;msg1498532#msg1498532

DoEvents¡! :P

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Karcrack en 15 Agosto 2010, 23:25 pm
Código:
If (x And 1) = 0 Then MsgBox "Funciona"
:P

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: LeandroA en 16 Agosto 2010, 01:19 am
Karcrack te queria manda un MP pero tenes la casilla llena o si estas en el msn mandame un msg

Saludos.

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Karcrack en 16 Agosto 2010, 01:50 am
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 :laugh: :laugh:)

Para mi hay un ganador claro a no ser que se demuestre lo contrario... :P... Asi que, ire pensando otro reto >:D :laugh:

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: raul338 en 16 Agosto 2010, 07:41 am
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 :P y hasta se me ocurrio usar listas enlazadas y doblemente enlazadas, pero mi base del algoritmo fallaba :xD

Muy impresionante lo que hicieron, y si, ya deberian ir cerrando y proclamar un ganador. Yo tengo un reto para mas tarde :P

Título: Re: [RETO] Comprobar si un numero dado es un numero de la suerte
Publicado por: Dessa en 17 Agosto 2010, 23:58 pm
EDITO:

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









Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines