elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Curso de javascript por TickTack


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  [RETO] Comprobar si un numero dado es un numero de la suerte		0 Usuarios y 1 Visitante están viendo este tema.
Páginas: 1 2 3 [4] 5 6 Ir Abajo Respuesta Imprimir
Autor Tema: [RETO] Comprobar si un numero dado es un numero de la suerte  (Leído 21,923 veces)
Dessa


Desconectado Desconectado

Mensajes: 624



Ver Perfil
Re: [RETO] Comprobar si un numero dado es un numero de la suerte
« Respuesta #30 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
« Última modificación: 15 Agosto 2010, 08:53 am por Dessa » En línea
Adrian Desanti
Tokes

Desconectado Desconectado

Mensajes: 140


Ver Perfil
Re: [RETO] Comprobar si un numero dado es un numero de la suerte
« Respuesta #31 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
En línea
Angeldj27

Desconectado Desconectado

Mensajes: 199


Ahorra Agua... Beba Cerveza


Ver Perfil
Re: [RETO] Comprobar si un numero dado es un numero de la suerte
« Respuesta #32 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
En línea


"Que vamos a hacer Mañana?..... Lo mismo que hacemos todos los dias Pinky tratar de Conquistar el Mundoooo!!!!!
Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.089



Ver Perfil WWW
Re: [RETO] Comprobar si un numero dado es un numero de la suerte
« Respuesta #33 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
« Última modificación: 15 Agosto 2010, 02:11 am por *PsYkE1* » En línea
http://foro.h-sec.org/
LeandroA
Moderador
***
Desconectado Desconectado

Mensajes: 760


www.leandroascierto.com


Ver Perfil WWW
Re: [RETO] Comprobar si un numero dado es un numero de la suerte
« Respuesta #34 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
En línea
BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.158


I'Love...!¡.


Ver Perfil WWW
Re: [RETO] Comprobar si un numero dado es un numero de la suerte
« Respuesta #35 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!¡.
En línea
The Dark Shadow is my passion.
BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.158


I'Love...!¡.


Ver Perfil WWW
Re: [RETO] Comprobar si un numero dado es un numero de la suerte
« Respuesta #36 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!¡.
En línea
The Dark Shadow is my passion.
Dessa


Desconectado Desconectado

Mensajes: 624



Ver Perfil
Re: [RETO] Comprobar si un numero dado es un numero de la suerte
« Respuesta #37 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
En línea
Adrian Desanti
Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.089



Ver Perfil WWW
Re: [RETO] Comprobar si un numero dado es un numero de la suerte
« Respuesta #38 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
En línea
http://foro.h-sec.org/
Tokes

Desconectado Desconectado

Mensajes: 140


Ver Perfil
Re: [RETO] Comprobar si un numero dado es un numero de la suerte
« Respuesta #39 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.
En línea
Páginas: 1 2 3 [4] 5 6 Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
Convertidor de número literal a número real
Programación C/C++ 		david_BS 0 2,430 Último mensaje 6 Mayo 2012, 21:34 pm
por david_BS
ayuda con un numero que se repita
Programación C/C++ 		daniel010 2 2,252 Último mensaje 13 Septiembre 2013, 03:02 am
por GenR_18
saber primer numero y ultimo numero [solucionado]
Bases de Datos 		basickdagger 4 4,153 Último mensaje 3 Septiembre 2014, 17:19 pm
por basickdagger
Generar numeros que contengan un numero dado x « 1 2 »
Programación C/C++ 		GoBrit 13 5,236 Último mensaje 17 Enero 2015, 02:28 am
por engel lex
Invertir un número dado
Programación C/C++ 		BortizF 3 2,828 Último mensaje 18 Octubre 2017, 16:20 pm
por BortizF
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines