Test Foro de elhacker.net SMF 2.1

Hooola!

No sabia si presentar esto como reto o no (?)


http://gaussianos.com/la-conjetura-del-196/
http://en.wikipedia.org/wiki/Lychrel_number


Ahi esta, tienen que hacer una funcion booleana que calcule los numeros capicuas a partir de este, con un numero maximo de vueltas, para calcular si es de Lychrel o no :P Ademas de devolver el numero final dado

La firma debe ser asi:


Public Function IsLychrelNumber(numero As Double, ByRef numeroFinal As Double,Optional maxVueltas As Long = 20) As Boolean


Si no se logra dar el numero de vueltas en menos de maxVueltas se toma como si fuera numero de Lychrel (aunque el numero este en la vuelta 21 :¬¬)

NOTA: Cabe aclarar que debe devolver True cuando no se encuentra el numero capicua  :silbar:

El tiempo se medira con la clase CTiming ya publicada en retos anteriores...

Ahora si! A codear!

Me apunto raul!! :D

DoEvents¡! :P

Tiene que ser en VB? xD

lo hare más tarde, pero en c++

Ya lo hice, ahora lo tengo que modificar :xD
Dada la manera en que se calcula el número, probando incluso con 89 (es uno de los ejemplos de wikipedia) se desborda, no sirven los long :xD

Saludos

Corregido! Puse como double los tipos de datos, asi no hay desbordamientos :P

HOLA!!!

Que bueno acabo de leer el post de novlucker y me saco las dudas

Gracias!!!

Function IsLychrelNumber(numero As Double, ByRef numeroFinal As Double, Optional maxVueltas As Long = 20) As Boolean

Dim i As Long
numeroFinal = numero

For i = 0 To maxVueltas
numeroFinal = numeroFinal + CDbl(StrReverse(CStr(numeroFinal)))
If (numeroFinal = CDbl(StrReverse(CStr(numeroFinal)))) Then Exit Function
Next
IsLychrelNumber = True

End Function

Entendí que numeroFinal era el último generado, así que comienzo con ese, sino lo quito y no lo uso :xD
De cualquier manera, esto sigue siendo funcional para números "pequeños", sino hay que hacer la suma mediante strings.

Saludos

Optimizando me quedo como la de novlucker!! :xD

Se me habia ocurrido comprar solo dando vuelta "despues de la mitad" del numero, pero... era mas lento ._.

Aca esta, se podria decir que es practicamente igual a la de novlucker, solo que esta funciona aun para numeros grandes :xD

Public Function EsLychrel(ByVal numero As Double, ByRef numeroFinal As Double, Optional maxVueltas As Long = 100) As Boolean
   Dim i As Long ' FAIL: As Integer xDDDD
   numeroFinal = Abs(numero) ' No permito numeros negativos
   If numero = CDbl(StrReverse(numero)) Then Exit Function ' Si el numero ya es capicua, para que me gasto? xD
   numeroFinal = Val(numero) ' Quito los decimales
   maxVueltas = Abs(maxVueltas) ' 1 a -10 (sumando 1) es imposible xDDD, quito los negativos
   For i = 1 To maxVueltas
       ' Sumo el normal y el numero al revez, poniendo formato numerico comun
       numeroFinal = numeroFinal + CDbl(StrReverse(FormatNumber(numeroFinal, 0, vbTrue, vbFalse, vbFalse)))
       ' Comparo si es el mismo :P
       If FormatNumber(numeroFinal, 0, vbTrue, vbFalse, vbFalse) = StrReverse(FormatNumber(numeroFinal, 0, vbTrue, vbFalse, vbFalse)) Then Exit Function
   Next
   EsLychrel = True
End Function


EDIT: Hecho en 56957,0293718157 ms, 10 To 100000, maxVueltas = 1000 (con DoEvents entre calculo de cada numero :xD)

Dudo que tan grandes, la variable numeroFinal tiene un límite y ahí crashea.
Además, los códigos funcionan porque tiene el maxVueltas bajo, donde lo agrandes muere :xD

[Edito]: El mío crashea con números más chicos xD

Saludos

Ahí se los dejo, n se que tan weno sea eso, porque ni lo probé, no se si funciona en VB6 xD

me avisan xD

Public Function IsLychrelNumberDanger(ByVal numero As Double, ByRef numeroFinal As Double, ByRef actualit As Integer, Optional ByVal maxVueltas As Long = 60) As Boolean
        actualit = actualit + 1
        Dim original As String
        original = CStr(numero)
        Dim reverse As String
        reverse = StrReverse(original)

        If original = reverse Then
            IsLychrelNumberDanger = False
        End If

        If actualit = maxVueltas Then
            IsLychrelNumberDanger = True
        End If
        numeroFinal = CDbl(reverse) + numero
        IsLychrelNumberDanger = IsLychrelNumberDanger(numeroFinal, numeroFinal, actualit, maxVueltas)
End Function




Saludos!

PD: Primero y ultimo que hago en VB xD
PD2: gracias a raul por portar el code a vb6 xD

Ahora entiendo por que decías que no servía cuando lo pasabas de VB.NET a VB6 :xD

El de raul338 es el "más válido", a la próxima le pongo todas las verificaciones esas, yo simplemente las omití porque entendí que los números de prueba iban a ser válidos para la función :P

Saludos

jajaja las validaciones las agregue al final :P

D4N93R propone agregar un parametro con el numero de iteraciones dado para llegar al resultado final, que dicen, lo ponemos? (seria devolver i en mi caso :xD)

Eso es porque necesita una excusa para poder agregar una parámetro más a la función, el que usa para la recursividad :xD

Saludos

Buen día, gente. Aquí les dejo mi aporte:

Private Function EsNumLychrel4(ByVal num As Long, ByRef numeroFinal, Optional ByVal iteraciones As Long = 50) As Boolean
Dim n As Double, snrev As String
    If num And &H80000000 Then Exit Function
    n = num
    Do While iteraciones > 1
        snrev = StrReverse(n)
        If CStr(n) = snrev Then Exit Function
        n = n + CDbl(snrev)
        iteraciones = iteraciones - 1
    Loop
    snrev = StrReverse(n)
    If CStr(n) = snrev Then Exit Function
    EsNumLychrel4 = True
    numeroFinal = n
End Function

Por el momento es todo. Saludos.

Aquí les dejo otra versión que según yo es más rápida.

Private Function EsNumLychrel5(ByVal num As Long, ByRef numeroFinal, 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 > 1
        nrev = CDbl(StrReverse(n))
        If n = nrev Then Exit Function
        n = n + nrev
        iteraciones = iteraciones - 1
    Loop
    nrev = CDbl(StrReverse(n))
    If n = nrev Then Exit Function
    EsNumLychrel5 = True
    numeroFinal = n
End Function

          ¡Buen día!

No me da tiempo a leerme la documentacion ni nada, pero veo que estais dando la vuelta al numero usando cadenas... Esto puede que os ayude a mejorar la velocidad :)

Public Function lngReverse(ByVal lLong As Long) As Long
   Do
       lngReverse = (lngReverse * 10) + (lLong Mod 10)
       lLong = lLong \ 10
   Loop While lLong > 0
End Function

Saludos ;)

Despues de que se me trabo la inche PC reice mi codigo aqui esta!¡.



Public Function IsLychrelNumberBlackZeroX(ByVal InVal As Double, ByRef OutValEnd As Double, Optional InMaxVueltas As Long = 20) As Boolean
    If InVal And &H80000000 Then Exit Function
    OutValEnd = InVal
    Do Until OutValEnd > 9
        OutValEnd = OutValEnd + OutValEnd
        InMaxVueltas = InMaxVueltas - 1
    Loop
    Do Until InMaxVueltas < 1 'Or IsLychrelNumberBlackZeroX = True
        InVal = StrReverse(OutValEnd) + 0
        IsLychrelNumberBlackZeroX = InVal - OutValEnd = 0
        If IsLychrelNumberBlackZeroX Then Exit Do
        OutValEnd = OutValEnd + InVal
        InMaxVueltas = InMaxVueltas - 1
    Loop
    IsLychrelNumberBlackZeroX = True
End Function



Ducles Lunas!¡.

Citar

Código (vb) [Seleccionar] Expandir

InVal = StrReverse(OutValEnd) + 0

Le sumas cero por algo en particular?¿

DoEvents¡! :P

strreverse devuelve un string yo a ese string le sumo 0 para pasarlo a numero, igual como le hago en C...

aqui lo dejo corregido

Version 2.

Public Function IsLychrelNumberBlackZeroX02(ByVal InVal As Double, ByRef OutValEnd As Double, Optional InMaxVueltas As Long = 20) As Boolean
    If InVal And &H80000000 Then Exit Function
    OutValEnd = InVal
    Do Until OutValEnd > 9
        OutValEnd = OutValEnd + OutValEnd
        InMaxVueltas = InMaxVueltas - 1
    Loop
    Do Until InMaxVueltas < 1 'Or IsLychrelNumberBlackZeroX = True
        InVal = StrReverse(OutValEnd) + 0
        If InVal - OutValEnd = 0 Then Exit Do
        OutValEnd = OutValEnd + InVal
        InMaxVueltas = InMaxVueltas - 1
    Loop
    IsLychrelNumberBlackZeroX02 = True
End Function



Version 3.


Public Function IsLychrelNumberBlackZeroX03(ByVal InVal As Double, ByRef OutValEnd As Double, Optional InMaxVueltas As Long = 20) As Boolean
Dim tmp             As Double
    If InVal And &H80000000 Then Exit Function
    OutValEnd = InVal
    Do Until OutValEnd > 9
        OutValEnd = OutValEnd + OutValEnd
        InMaxVueltas = InMaxVueltas - 1
    Loop
    Do Until InMaxVueltas < 1
        tmp = OutValEnd: InVal = 0
        Do
            InVal = (InVal * 10) + (tmp Mod 10)
            tmp = tmp \ 10
        Loop While tmp > 0
        If InVal - OutValEnd = 0 Then Exit Do
        OutValEnd = OutValEnd + InVal
        InMaxVueltas = InMaxVueltas - 1
    Loop
    IsLychrelNumberBlackZeroX03 = True
End Function



Dulces Lunas!¡.

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

DoEvents¡! :P

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

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



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!¡.

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

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):

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 (v 3)

esta en base a la funcion de Karcrack xP

porque siempre las mias es una de las mas lentas? :xD

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

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


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.

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

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.

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

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!

CitarSi alguien gusta hacerle alguna modiicación ¡Adelante!

Si, yo si se la voy ha hacer, aqui esta:
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... :laugh: :laugh:

DoEvents¡! :P

¡Ja, ja! Soy un imbécil. Pero bueno, gracias, PsYkE1.

Bien LeandroA, ya puse el filtro para que no acepte numeros de un digito, y que si es capicua que calcule igual :P

Los numeros de 1 solo digito no pueden ser calculados, ya que nunca cumpliran la condicion de ser capicua

Visual Basic sucks.. xD  :-X :-X :-X :-X :-X :-X :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬
:silbar: :silbar: :silbar: :silbar: :silbar: :silbar: :silbar: :silbar:

Citar

Código [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

Cita de: [D4N93R] en 19 Agosto 2010, 01:32 AM
Visual Basic sucks.. xD  :-X :-X :-X :-X :-X :-X :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬
:silbar: :silbar: :silbar: :silbar: :silbar: :silbar: :silbar: :silbar:

:silbar: >:D
Pd: El post para meterse con VB esta aqui:
http://foro.elhacker.net/programacion_visual_basic/iquesttu_tambien_crees_que_visual_basic_es_para_tontos-t302471.0.html
:laugh:


DoEvents¡!  :-*

Gracias xD ya postié ahí xD :D