[RETO] ¿Fácil? Buscando los números de Lychrel

[Psyke1]

Interesante, no conozco esos truquillos, supongo que es mas rapido que convertirlo con CDbl(), no?¿

DoEvents¡!

[Karcrack]

Deberia ser mas rapida mi funcion de lngReverse() que el StrReverse()... Alguien ha provado? XD

[BlackZeroX]

no comprove coherencias!¡, por lo cual no comprove que estubieran bien dichas funciones

Código (vb) [Seleccionar] Expandir



Tokes: 128,759 msec
[D4N93R]: 10.388,359 msec
Raul338: 308,872 msec
Novlucker : 131,863 msec
BlackZeroX (v 2): 96,643 msec
BlackZeroX (v 3): 35,655 msec



http://infrangelux.sytes.net/FileX/index.php?file=/BlackZeroX/Comprovaciones/Lychrel/Gral%20Lychrel%2001.zip&dir=/BlackZeroX/Comprovaciones/Lychrel&

P.D.: En efecto Karcrack es mas rapido!¡.

Dulces Lunas!¡.

[Tokes]

Aquí dejo un nuevo código, basado en la función que nos mostró Karcrack.

Código [Seleccionar] Expandir

Private Function EsNumLychrel5(ByVal num As Long, ByRef numeroFinal, Optional ByVal iteraciones As Long = 50) As Boolean
Dim n As Double, nrev As Double, sp As String
    If num And &H80000000 Then Exit Function
    n = num
    sp = "1234"
    Do While iteraciones > 1
        nrev = dblReverse(n)
        If n = nrev Then Exit Function
        n = n + nrev
        iteraciones = iteraciones - 1
    Loop
    nrev = dblReverse(n)
    If n = nrev Then Exit Function
    EsNumLychrel5 = True
    numeroFinal = n
End Function

Y la función de Karcrack (modificada para que pueda manejar doubles y no sólo longs):

Código [Seleccionar] Expandir

Public Function dblReverse(ByVal lDbl As Double) As Double
    Do
        dblReverse = dblReverse * 10 + (lDbl - (10 * Fix(lDbl / 10)))
        lDbl = Fix(lDbl / 10)
    Loop While lDbl > 0
End Function

     Efectivamente es más rápido.

     Saludos....
     Y muchas gracias Karcrack.

[BlackZeroX]

BlackZeroX (v 3)

esta en base a la funcion de Karcrack xP

[raul338]

porque siempre las mias es una de las mas lentas?

bueno, con la base de Karcrack y tokes, me quedo esto, un poquitin mas rapido que la de tokes pero muchisimo mas rapida que la mia anterior

Código (vb) [Seleccionar] Expandir

Public Function EsLychrel02(ByVal numero As Double, ByRef numeroFinal As Double, Optional maxVueltas As Long = 100) As Boolean
    If &H80000000 And maxVueltas Then Exit Function
    If numero < 10 Then Exit Function
    numeroFinal = numero
   
    numero = dblReverse(numeroFinal)
    If numeroFinal = numero Then
        numeroFinal = numero + numero
        Exit Function
    End If
   
    For maxVueltas = maxVueltas To 1 Step -1
        numero = dblReverse(numeroFinal)
        If numeroFinal = numero Then Exit Function
        numeroFinal = numeroFinal + numero
    Next
    EsLychrel02 = True
End Function


[Tokes]

Disculpen, hace rato puse mi código pero con instrucciones basura que nada que ver con el proceso (era para probar ciertas funciones). Aquí se los dejo corregido. Tiene prácticamente la misma velocidad de antes, pero sin ese código basura.

Código [Seleccionar] Expandir

Private Function EsNumLychrel5(ByVal num As Long, ByRef numeroFinal As Double, Optional ByVal iteraciones As Long = 50) As Boolean
Dim n As Double, nrev As Double
    If num And &H80000000 Then Exit Function
    n = num
    Do While iteraciones > 0
        nrev = dblReverse(n)
        If n = nrev Then Exit Function
        n = n + nrev
        iteraciones = iteraciones - 1
    Loop
    nrev = dblReverse(n)
    If n = nrev Then Exit Function
    EsNumLychrel5 = True
    numeroFinal = n
End Function

[LeandroA]

creo que por el momento la unica que funciona bien es la de Novlucker las demas no esta trabajando correctamente

solo tengo mis dudas con la de Novlucker  con los numeros del 1 al 9 ya que dan numeros simples y no se cumple la condición de capicua

la de raul338  tambien anda bien con el mismo problea que el de Novlucker   y tambien pero hay un problema con el 11 ya que da como resultado 11 cuando deberia ser 22


@BlackZeroX

0 = blucle infinito
la funcion deve devolver true si no se logra el capicua en los determinados ciclos
tambien el problema del 1 al 10 pero peor, muestra erronos

@Tokes no estas devolviendo "numeroFinal" correctamente.

[Tokes]

Disculpen, es cierto. Según yo ya devuelvo numero final en este código.

Código [Seleccionar] Expandir

Private Function EsNumLychrel5b(ByVal num As Long, ByRef numeroFinal As Double, Optional ByVal iteraciones As Long = 50) As Boolean
Dim n As Double, nrev As Double
    If num And &H80000000 Then Exit Function
    n = num
    Do While iteraciones > 0
        nrev = dblReverse(n)
        If n = nrev Then
            numeroFinal = n
            Exit Function
        End If
        n = n + nrev
        iteraciones = iteraciones - 1
    Loop
    nrev = dblReverse(n)
    If n = nrev Then Exit Function
    EsNumLychrel5b = True
    numeroFinal = n

Si alguien gusta hacerle alguna modiicación ¡Adelante!

[Psyke1]

Si alguien gusta hacerle alguna modiicación ¡Adelante!

Si, yo si se la voy ha hacer, aqui esta:

Código (vb) [Seleccionar] Expandir

Private Function EsNumLychrel5b(ByVal num As Long, ByRef numeroFinal As Double, Optional ByVal iteraciones As Long = 50) As Boolean
Dim n As Double, nrev As Double
   If num And &H80000000 Then Exit Function
   n = num
   Do While iteraciones > 0
       nrev = dblReverse(n)
       If n = nrev Then
           numeroFinal = n
           Exit Function
       End If
       n = n + nrev
       iteraciones = iteraciones - 1
   Loop
   nrev = dblReverse(n)
   If n = nrev Then Exit Function
   EsNumLychrel5b = True
   numeroFinal = n
End Function
Faltaba el End Function...

DoEvents¡!