Autor
|
Tema: [RETO] Comprobar si un numero dado es un numero de la suerte (Leído 22,113 veces)
|
Psyke1
Wiki
Desconectado
Mensajes: 1.089
|
Leandro, probando como dice Karcrack (que devuelva un Boolean ingresando un numero Long) es un "Misil", muy buena, no era que las matematicas no eran tu fuerte ? Oh dios!! Es verdad, va como un tiro!! Las Collections son mas apropiadas cuando se trabaja con poca cantidad de Items... Por eso acabo de hacer esta tercera versión, es la mas rápida de las mias, y de velocidad anda pareja con la de LeandroA : Option Explicit Private Declare Sub RtlMoveMemory Lib "Kernel32" (ByVal Destination As Any, ByVal Source As Any, ByVal length As Long) Public Function Check_Lucky_Number3(ByVal lNumber As Long) As Boolean Dim lTempArray() As Long Dim NextElim As Long Dim lArrayUBound As Long Dim m As Long Dim x As Long If lNumber = 1 Or lNumber = 3 Then GoTo IsLucky ElseIf (lNumber > 1) And (lNumber Mod 2 <> 0) Then m = 1 For x = 1 To lNumber Step 2 ReDim Preserve lTempArray(m) lTempArray(m) = x m = m + 1 Next NextElim = 3: m = 2 Do x = NextElim Do While x <= UBound(lTempArray) lArrayUBound = UBound(lTempArray) If Not x = lArrayUBound Then RtlMoveMemory VarPtr(lTempArray(x)), VarPtr(lTempArray(x + 1)), (lArrayUBound - x) * 4 ReDim Preserve lTempArray(lArrayUBound - 1) Else Exit Function End If x = x + (NextElim - 1) Loop m = m + 1 NextElim = lTempArray(m) Loop While Not NextElim > lArrayUBound IsLucky: Check_Lucky_Number3 = True End If End Function
Testeado con GetTickCount: LeandroA IsLuckyNumber ---> 125 PsyKe1 Check_Lucky_Number3 ---> 125 @DessaMe referia a que hicieses algo asi: Option Explicit Function IsLucky2(lngNum As Long) As Boolean Dim x As Long, cont As Long, contStep As Long, Indice As Long, numLuck() As String If lngNum < 1 Or lngNum Mod 2 = 0 Or lngNum = 5 Then Exit Function If lngNum = 1 Or lngNum = 3 Then IsLucky2 = True: Exit Function For x = 1 To lngNum Step 2 ReDim Preserve numLuck(contStep) numLuck(contStep) = x contStep = contStep + 1 Next contStep = 0: cont = 0: Indice = 1 While numLuck(Indice) <= UBound(numLuck) For x = 0 To UBound(numLuck) If cont = numLuck(Indice) - 1 Then cont = 0 Else numLuck(contStep) = numLuck(x) cont = cont + 1 contStep = contStep + 1 End If Next If contStep = numLuck(Indice + 1) Then ReDim Preserve numLuck(contStep - 2) Else ReDim Preserve numLuck(contStep - 1) If numLuck(UBound(numLuck)) <> lngNum Then Exit Function cont = 0 contStep = 0 Indice = Indice + 1 Wend IsLucky2 = True End Function
IsLucky : 147,75 ms IsLucky2 : 87,45 ms @KarcrackUna duda con tu code: If (lNumb And 1 = 0) Then Exit Function
Esto para que es?¿ Es como hacer Mod?¿ DoEvents¡!
|
|
« Última modificación: 13 Agosto 2010, 20:36 pm por *PsYkE1* »
|
En línea
|
|
|
|
Karcrack
Desconectado
Mensajes: 2.416
Se siente observado ¬¬'
|
Puff, me descuido un dia y me dejais completamente atras , ya os descuidareis y despertare a todas mis neuronas muahahahhaha! @Psyke: Es para comprobar que sea par, es muchiiiisimo mas rapido que hacer un Mod, es lo que te dije, trabajar con Bits
|
|
|
En línea
|
|
|
|
Tokes
Desconectado
Mensajes: 140
|
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
|
|
|
En línea
|
|
|
|
Psyke1
Wiki
Desconectado
Mensajes: 1.089
|
Puff, me descuido un dia y me dejais completamente atras , ya os descuidareis y despertare a todas mis neuronas muahahahhaha! @Psyke: Es para comprobar que sea par, es muchiiiisimo mas rapido que hacer un Mod, es lo que te dije, trabajar con Bits Jajajajaja Tengo ganas de ver tu nueva version, pero espero que no quedemos todos empate... @Tokes
No te ofendas, pero tu codigo esta bastante desorganizado, pon el codigo entre [ code=vb ] aqui tu codigo [ /code ] 'Sin espaciosEl code es demasiado largo y lento... Dim bufA(33000) As Long Dim bufB(33000) As Long o_O Aún asi creo que te esforzaste... DoEvents¡!
|
|
« Última modificación: 14 Agosto 2010, 00:59 am por *PsYkE1* »
|
En línea
|
|
|
|
Dessa
Desconectado
Mensajes: 624
|
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 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
|
|
« Última modificación: 14 Agosto 2010, 01:54 am por Dessa »
|
En línea
|
Adrian Desanti
|
|
|
Psyke1
Wiki
Desconectado
Mensajes: 1.089
|
@DessaCreo 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 si que se nota la diferencia porque tiene que hacer 500 comprobaciones... Lo ideal es probar la funcion de las dos maneras...
@KarcrackPrivate Sub Form_Load() Dim x As Long For x = 0 To 10000 If (x And 1 = 0) Then MsgBox "Funciona" Next End Sub
DoEvents¡!
|
|
« Última modificación: 14 Agosto 2010, 02:41 am por *PsYkE1* »
|
En línea
|
|
|
|
Tokes
Desconectado
Mensajes: 140
|
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. 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: 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.
|
|
|
En línea
|
|
|
|
cobein
|
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. 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
|
|
« Última modificación: 14 Agosto 2010, 13:04 pm por cobein »
|
En línea
|
|
|
|
Angeldj27
Desconectado
Mensajes: 199
Ahorra Agua... Beba Cerveza
|
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 Public Function LuckyNumber(ByVal N As Long) As Boolean Dim ANumero() As Long Dim AText1() As Long Dim i As Integer Dim X As Integer i = 1 X = 1 If N Mod 2 = 0 Then Exit Function For i = 1 To N Step 2 ANumero(X) = i X = X + 1 Next For i = 0 To UBound(ANumero) Step 3 If ANumero(i) = N Then Exit Function ANumero(i) = 0 Next X = 1 For i = 1 To UBound(ANumero) If ANumero(i) <> 0 Then AText1(X) = ANumero(i) X = X + 1 End If Next For i = 0 To UBound(AText1) Step 7 If AText1(i) = N Then Exit Function Next LuckyNumber = True End Function
No se si es muy rapida pero funciona bien
|
|
« Última modificación: 14 Agosto 2010, 18:50 pm por Angeldj27 »
|
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
Mensajes: 1.089
|
@Angeldj27No 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¡!
|
|
|
En línea
|
|
|
|
|
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,442
|
6 Mayo 2012, 21:34 pm
por david_BS
|
|
|
ayuda con un numero que se repita
Programación C/C++
|
daniel010
|
2
|
2,263
|
13 Septiembre 2013, 03:02 am
por GenR_18
|
|
|
saber primer numero y ultimo numero [solucionado]
Bases de Datos
|
basickdagger
|
4
|
4,206
|
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,277
|
17 Enero 2015, 02:28 am
por engel lex
|
|
|
Invertir un número dado
Programación C/C++
|
BortizF
|
3
|
2,855
|
18 Octubre 2017, 16:20 pm
por BortizF
|
|