Autor
|
Tema: [RETO] Comprobar si un numero dado es un numero de la suerte (Leído 22,004 veces)
|
Psyke1
Wiki
Desconectado
Mensajes: 1.089
|
Me he tomado la libertad de ir testeando, aunque habria que probarlo en más PCs... Utilizando: cTiming.clsPrivate tmr As CTiming Option Explicit Option Base 1 'Karcrack Public Static Function IsItLucky(ByVal lNumb As Long) As Boolean Dim bvSieve() As Byte Dim lJump As Long Dim lLastNumb As Long Dim i As Long Dim iCount As Long Dim xCount As Long Dim x As Long If lNumb = 1 Or lNumb = 3 Then IsItLucky = True: Exit Function If (lNumb And 1 = 0) Then Exit Function If lJump = 0 Then lJump = 2 If lLastNumb < lNumb Then ReDim Preserve bvSieve(lNumb) iCount = 0 xCount = 1 Do For i = 1 To lNumb If bvSieve(i) = False Then iCount = iCount + 1 If iCount = lJump Then bvSieve(i) = True iCount = 0 End If Next i iCount = 0 xCount = xCount + 1 For i = 1 To lNumb If bvSieve(i) = False Then x = x + 1 If x = xCount Then lJump = i x = 0 Exit For End If End If Next i Loop Until xCount > lJump End If IsItLucky = Not bvSieve(lNumb) lLastNumb = lNumb End Function '*PsYkE1* Public Function Check_Lucky_Number(ByVal lNumber As Long) As Boolean Dim cTemp As New Collection Dim NextElim As Long Dim m As Long Dim x As Long If lNumber = 1 Or lNumber = 3 Then GoTo IsLucky ElseIf (lNumber > 1) And (lNumber Mod 2 <> 0) Then With cTemp For x = 1 To lNumber Step 2 .Add x Next NextElim = 3: m = 2 Do x = NextElim Do While x <= .Count .Remove (x) x = x + (NextElim - 1) Loop If .Item(.Count) = lNumber Then m = m + 1 NextElim = .Item(m) Else Exit Function End If Loop While Not NextElim > .Count End With IsLucky: Check_Lucky_Number = True End If End Function ' LeandroA Private Function IsLuckyNumber(ByVal Num As Long) As Boolean Dim lCount As Long, lPos As Long Dim c As New Collection If Num < 1 Then Exit Function If Num Mod 2 = 0 Then Exit Function For lPos = 1 To Num Step 2 c.Add lPos Next lCount = 1 Do While c.Count > lCount lCount = lCount + 1 lPos = c(lCount) Do If lPos > c.Count Then Exit Do c.Remove lPos lPos = lPos + c(lCount) - 1 Loop If c(c.Count) <> Num Then Exit Function Loop IsLuckyNumber = True End Function Private Sub Form_Load() Dim x As Long Dim sResult As String Set tmr = New CTiming tmr.Reset For x = 1 To 500 If IsLuckyNumber(x) Then ' Aqui los voy probando uno a uno... :P sResult = sResult & x & " " End If Next MsgBox tmr.sElapsed Debug.Print sResult End Sub
Mis resultados: LeandroA: 28,734 Karcrack : 69,309 *PsYkE1* : 19,923DoEvents¡!
|
|
|
En línea
|
|
|
|
ssccaann43 ©
Desconectado
Mensajes: 792
¬¬
|
Jajajajaja...! *PsYkE1* te has vuelto un adicto al Collection...!
Excelente trabajo...! Me gustó..!
|
|
|
En línea
|
- Miguel Núñez Todos tenemos derechos a ser estupidos, pero algunos abusan de ese privilegio... "I like ^TiFa^"
|
|
|
Karcrack
Desconectado
Mensajes: 2.416
Se siente observado ¬¬'
|
Mi codigo todavia no es funcional, tiene varios fallos, por ejemplo, en la segunda llamada da errores, debido a que dejo las variables llenas de basura... a ver si consigo mañana algo de tiempo y hago la version raaaapida Buen trabajo Psyke, veo que has exprimido al maximo las neuronas, a mi me dejo con dolor de cabeza , tanto tiempo sin pensar...
|
|
|
En línea
|
|
|
|
Psyke1
Wiki
Desconectado
Mensajes: 1.089
|
Jajajajaja...! *PsYkE1* te has vuelto un adicto al Collection...!
Excelente trabajo...! Me gustó..! Jajajajajaja Eso es por culpa de Karcrack! Él me volvió adicto... Mi codigo todavia no es funcional, tiene varios fallos, por ejemplo, en la segunda llamada da errores, debido a que dejo las variables llenas de basura... a ver si consigo mañana algo de tiempo y hago la version raaaapida Buen trabajo Psyke, veo que has exprimido al maximo las neuronas, a mi me dejo con dolor de cabeza , tanto tiempo sin pensar... Gracias¡! Si te digo la verdad, en un momento me pareció tan desesperante que pense en mandarlo a la m****a... Aun asi el reto me gustó, de paso planteo una pregunta: Esto que hemos hecho tiene alguna utilidad?¿ DoEvents¡!
|
|
|
En línea
|
|
|
|
Dessa
Desconectado
Mensajes: 624
|
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). , lo dicho con que funcione está bien para mí. 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
|
|
|
En línea
|
Adrian Desanti
|
|
|
Psyke1
Wiki
Desconectado
Mensajes: 1.089
|
Hola Dessa!! He mirado el code, puedes ganar un poco de velocidad si haces esto: If numLuck(UBound(numLuck)) = lngNum Then IsLucky = True
En vez de esto: For x = 0 To UBound(numLuck) If numLuck(x) = lngNum Then IsLucky = True Exit For End If Next
Teniendo en cuenta que el número que buscas siempre estara el ultimo,y te evitas recorrer tooooooodo el array, mas tarde lo miro con mas detenimiento que tengo prisa... DoEvents¡!
|
|
|
En línea
|
|
|
|
LeandroA
|
Aca otra version mas rapida de la mia pero sin collection y con array. esta utiliza CopyMemory segun como esta aquiOption Explicit Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long) 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 For lPos = 1 To Num Step 2 i = i + 1 ReDim Preserve Arr(i) 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
|
|
|
|
LeandroA
|
a con esto es mas rapido ReDim Preserve Arr(CLng(Num / 2) + (Num Mod 2)) For lPos = 1 To Num Step 2 i = i + 1 Arr(i) = lPos Next
|
|
|
En línea
|
|
|
|
|
Dessa
Desconectado
Mensajes: 624
|
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"
|
|
« Última modificación: 13 Agosto 2010, 13:13 pm por Dessa »
|
En línea
|
Adrian Desanti
|
|
|
|
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,434
|
6 Mayo 2012, 21:34 pm
por david_BS
|
|
|
ayuda con un numero que se repita
Programación C/C++
|
daniel010
|
2
|
2,256
|
13 Septiembre 2013, 03:02 am
por GenR_18
|
|
|
saber primer numero y ultimo numero [solucionado]
Bases de Datos
|
basickdagger
|
4
|
4,172
|
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,258
|
17 Enero 2015, 02:28 am
por engel lex
|
|
|
Invertir un número dado
Programación C/C++
|
BortizF
|
3
|
2,837
|
18 Octubre 2017, 16:20 pm
por BortizF
|
|