Test Foro de elhacker.net SMF 2.1

Programación => .NET (C#, VB.NET, ASP) => Programación General => Programación Visual Basic => Mensaje iniciado por: Miseryk en 23 Octubre 2013, 11:44 AM

Título: [RETO] Determinar Número Perfecto
Publicado por: Miseryk en 23 Octubre 2013, 11:44 AM
Hola a todos, los invito a que programen a gusto si un número es perfecto o no.

Cómo funciona un número perfecto?

Un número es perfecto, cuando la SUMA de TODOS sus divisores, evadiendo a si mismo, es igual a ese número.

Ej:

6: 1+2+3 = 6
28: 1+2+4+7+14 = 28
etc

Lista:
6
28
496
8128
33550336
8589869056
137438691328
2305843008139952128

Valoro pensamientos/deducciones propias :D
Título: Re: [RETO] Determinar Número Perfecto
Publicado por: ivancea96 en 23 Octubre 2013, 12:09 PM
No lo pillo.
Cita de: Miseryk en 23 Octubre 2013, 11:44 AM
los invito a que programen a gusto si un número es perfecto o no.
¿Si un número es perfecto o no? Los números perfectos, como bien explicaste, son los que cumplen esa condición.
¿Se trata de descubrir cuales de esos números no es erfecto o algo así?
xD
Título: Re: [RETO] Determinar Número Perfecto
Publicado por: 79137913 en 23 Octubre 2013, 13:18 PM
HOLA!!!

Hay que crear un verificador de numeros perfectos o un generador?

GRACIAS POR LEER!!!
Título: Re: [RETO] Determinar Número Perfecto
Publicado por: Miseryk en 23 Octubre 2013, 14:12 PM
A lo que me refiero es que el usuario ingrese un número en un textbox y al hacer click en un button le informe si el número ingresado es perfecto o no. :P
Título: Re: [RETO] Determinar Número Perfecto
Publicado por: Mad Antrax en 23 Octubre 2013, 14:50 PM
Es más divertido hacer un generador. Mola mucho programar funciones recursivas
Título: Re: [RETO] Determinar Número Perfecto
Publicado por: 79137913 en 23 Octubre 2013, 15:05 PM
HOLA!!!

Que comience el reto!

Ejemplo de la funcion:
Código (vb) [Seleccionar]
Private Function IsPerfect(N as double) as Boolean

Si quieren hacer una funcion que devuelva el x numero perfecto aqui la funcion:
Código (vb) [Seleccionar]
Private Function GetPerfect(N as  Long) as double
y que devuelva el N numero perfecto de la lista!

GRACIAS POR LEER!!!
Título: Re: [RETO] Determinar Número Perfecto
Publicado por: Slava_TZD en 23 Octubre 2013, 15:15 PM
Ya contareis cuanto os tarda en comprobar el último número, lo acabo de hacer en Perl y lo cerré porque mi macTrasto se puso hirviendo.
Título: Re: [RETO] Determinar Número Perfecto
Publicado por: 79137913 en 23 Octubre 2013, 15:56 PM
HOLA!!!

Mi funcion puede verificar los numeros perfectos sin problema, probe con el ultimo que esta aca y lo verifica en menos de 0,1 ms .-

Para que vean que lo que importa es el algoritmo no el lenguaje ;)

Código (vb) [Seleccionar]
Private Function IsPerfect(N As Double) As Boolean
   Dim Sum As Double
   Dim Aux As Double
   Aux = N / 2
   Sum = 1 + Aux
   Do While Aux > 2
       If Fix(Aux / 2) < Aux / 2 Then
           Aux = Aux + 1
       End If
       Aux = Aux / 2
       Sum = Sum + Aux
   Loop
   IsPerfect = (N = Sum)
End Function


Superenme ;)

GRACIAS POR LEER!!!
Título: Re: [RETO] Determinar Número Perfecto
Publicado por: Miseryk en 23 Octubre 2013, 16:28 PM
Mi código, con un par de deducciones que hice ;)

Código (vb) [Seleccionar]

Public Function IsPerfect(ByRef numero As Double) As Boolean
Dim loopc As Double
Dim calc As Double

Dim NumStr As String
Dim LastNum As Byte

NumStr = CStr(numero)
LastNum = CByte(Mid(NumStr, Len(NumStr), 1))

Dim Max As Variant

Max = Fix(CDbl(numero) / CDbl(2))

If LastNum = 6 Or LastNum = 8 Then
   For loopc = Max To 1 Step -1
       'If numero Mod loopc = 0 Then
       If numero Mod loopc = 0 Then
           calc = calc + loopc

           If calc > numero Then
               IsPerfect = False
               Exit Function
           End If
       End If
   Next loopc
End If

IsPerfect = (calc = numero)
End Function


Modificación.
Título: Re: [RETO] Determinar Número Perfecto
Publicado por: 79137913 en 23 Octubre 2013, 16:34 PM
HOLA!!!

Me parece o alguien tomo de base mi ejemplo funcion... :silbar: :silbar: :silbar: :silbar: :silbar:

P.D: tu funcion da OVERFLOW en esta linea cuando se inserta el numero 2305843008139952128 :
Código (vb) [Seleccionar]
       If numero Mod loopc = 0 Then

GRACIAS POR LEER!!!
Título: Re: [RETO] Determinar Número Perfecto
Publicado por: Miseryk en 23 Octubre 2013, 16:36 PM
Cita de: 79137913 en 23 Octubre 2013, 16:34 PM
HOLA!!!

Me parece o alguien tomo de base mi ejemplo funcion... :silbar: :silbar: :silbar: :silbar: :silbar:

GRACIAS POR LEER!!!

jajaja sí, yo a las funciones las llamo asd o sdav jajaja
Título: Re: [RETO] Determinar Número Perfecto
Publicado por: 79137913 en 23 Octubre 2013, 16:47 PM
HOLA!!!

Hice una pequeña prueba  con el maximo numero que soporta tu funcion y solo una llamada:
(http://i.imgur.com/PP1ZaCr.png)

For the record:
Mi funcion recien empieza a tener un tiempo registrable luego de las 1000 llamadas (4ms) con 10000 llamadas llega a 47ms!

Y por supuesto...
Con el numero: 2305843008139952128

@Miseryk :
En vez de buscar el ultimo digito de esa manera buscalo asi, ya que tu funcion no acepta numeros mayor que long te va a servir:
Código (vb) [Seleccionar]
Lastnum = Numero mod 10

GRACIAS POR LEER!!!
Título: Re: [RETO] Determinar Número Perfecto
Publicado por: Miseryk en 23 Octubre 2013, 16:57 PM
Código Completo:

Código (vb) [Seleccionar]

Option Explicit

'6
'28
'496
'8128
'33550336
'8589869056
'137438691328
'2305843008139952128

Public Function Misery_MOD(ByVal dividendo As Double, ByVal divisor As Double) As Double
'x / y = z
'y * z + R = x

'10 / 3 = 3,333
'10 / 3 = 3
Misery_MOD = dividendo - (divisor * Fix(dividendo / divisor))
End Function

Public Function IsPerfect(ByRef numero As Double) As Boolean
Dim loopc As Double
Dim calc As Double

Dim LastNum As Byte

Dim Max As Variant

Max = Fix(CDbl(numero) / CDbl(2))

'By 79137913
LastNum = numero Mod 10

If LastNum = 6 Or LastNum = 8 Then
    For loopc = Max To 1 Step -1
        'If numero Mod loopc = 0 Then
        If Misery_MOD(numero, loopc) = 0 Then
            calc = calc + loopc

            If calc > numero Then
                IsPerfect = False
                Exit Function
            End If
        End If
    Next loopc
End If

IsPerfect = (calc = numero)
End Function

Private Sub Form_Load()
'MsgBox 33550336 Mod 10
MsgBox IsPerfect(33550336)
End
End Sub


Modificación_2
Título: Re: [RETO] Determinar Número Perfecto
Publicado por: Miseryk en 23 Octubre 2013, 16:58 PM
Cita de: 79137913 en 23 Octubre 2013, 16:47 PM
HOLA!!!

Hice una pequeña prueba  con el maximo numero que soporta tu funcion y solo una llamada:
(http://i.imgur.com/PP1ZaCr.png)

For the record:
Mi funcion recien empieza a tener un tiempo registrable luego de las 1000 llamadas (4ms) con 10000 llamadas llega a 47ms!

Y por supuesto...
Con el numero: 2305843008139952128

@Miseryk :
En vez de buscar el ultimo digito de esa manera buscalo asi, ya que tu funcion no acepta numeros mayor que long te va a servir:
Código (vb) [Seleccionar]
Lastnum = Numero mod 10

GRACIAS POR LEER!!!

Wow, interesante, no se me había ocurrido.
Título: Re: [RETO] Determinar Número Perfecto
Publicado por: Miseryk en 23 Octubre 2013, 17:29 PM
Estuve probando ésto en .NET que soporta números muy grandes, y la función que hiciste en números muy grandes retorna True en todos los números, estoy pasándolo a VB.NET para que lo veas mejor.
Título: Re: [RETO] Determinar Número Perfecto
Publicado por: 79137913 en 23 Octubre 2013, 17:38 PM
HOLA!!!

Esto es VB6!!!!!!!! (con el tono de "ESTO ES ESPARTAAAAAA")

Que el No-Compilador de Net sea idiota no es mi problema.-

GRACIAS POR LEER!!!
Título: Re: [RETO] Determinar Número Perfecto
Publicado por: Miseryk en 23 Octubre 2013, 18:14 PM
Nono, es cierto, me faltó una conversión de tu función a UInt64, el código funciona bien y muy rápido :D :D
Título: Re: [RETO] Determinar Número Perfecto
Publicado por: Miseryk en 23 Octubre 2013, 19:19 PM
Voy a esperar a ver quién más postea algún código mientras mejoro el mio.

Estoy en .NET (solamente por el número que uso para testear la función) utilizando como prueba el número perfecto 2305843008139952128

Con respecto a los resultados en y con:
SO: Windows 7 Ultimate 64 bits
Procesador: Intel(R) Core(TM) i5-3570K CPU @ 3.40Ghz 3.40GHz
Memoria instalada (RAM): 16,0 GB

79137913:
Número: 2305843008139952128
Resultado: True
Tiempo Milisegs: 0,0084 (EL MÍNIMO TIEMPO POSIBLE DE DEMASIADOS INTENTOS)




PD: el mio no lo muestro porque necesito una computadora quántica para que me diga el tiempo que tarda, pero estoy en éso.
Título: Re: [RETO] Determinar Número Perfecto
Publicado por: Miseryk en 25 Octubre 2013, 18:23 PM
Cita de: 79137913 en 23 Octubre 2013, 15:56 PM
HOLA!!!

Mi funcion puede verificar los numeros perfectos sin problema, probe con el ultimo que esta aca y lo verifica en menos de 0,1 ms .-

Para que vean que lo que importa es el algoritmo no el lenguaje ;)

Código (vb) [Seleccionar]
Private Function IsPerfect(N As Double) As Boolean
   Dim Sum As Double
   Dim Aux As Double
   Aux = N / 2
   Sum = 1 + Aux
   Do While Aux > 2
       If Fix(Aux / 2) < Aux / 2 Then
           Aux = Aux + 1
       End If
       Aux = Aux / 2
       Sum = Sum + Aux
   Loop
   IsPerfect = (N = Sum)
End Function


Superenme ;)

GRACIAS POR LEER!!!

Mientras estuve tratando de crear un algoritmo, me dí cuenta que esa función retorna mal algunos valores como por ejemplo:

al verificar con el número 2 retorna Verdadero el cual no es perfecto.
al verificar con el número 12 retorna Verdadero el cual no es perfecto.
al verificar con el número 14 retorna Verdadero el cual no es perfecto.
al verificar con el número 24 retorna Verdadero el cual no es perfecto.
etc
Título: Re: [RETO] Determinar Número Perfecto
Publicado por: 79137913 en 26 Octubre 2013, 04:57 AM
HOLA!!!

:O

Lo soluciono el lunes!

GRACIAS POR LEER!!!
Título: Re: [RETO] Determinar Número Perfecto
Publicado por: rob1104 en 8 Noviembre 2013, 02:24 AM
Aui va mi función, es muy rapida  :rolleyes:
Código (vbnet) [Seleccionar]
Private Function esNumeroPerfecto(ByVal numero As Double) As Boolean
        Dim aux(7) As Double
        Dim i As Integer
        aux(0) = 6
        aux(1) = 28
        aux(2) = 496
        aux(3) = 8128
        aux(4) = 33550336
        aux(5) = 8589869056
        aux(6) = 137438691328
        aux(7) = 2305843008139952128

        For i = 0 To 7
            If numero = aux(i) Then
                Return True
            End If
        Next
        Return False
End Function



Jaja fuera bromas, esto es lo que pude hacer, aunque con numeros muy grandes tarda una eternidad  :-\
Código (vbnet) [Seleccionar]
Este se tarda una eternidad en comprobar los ultimos 2 numeros de la lista
Private Function esNumeroPerfecto(ByVal numero As Double) As Boolean
        Dim aux As Double = 1
        Dim aux2 As Double = 0
        Dim sum As Double = 0
        While aux <= (numero / 2)
            aux2 = numero Mod aux
            If aux2 = 0 Then
                sum += aux
            End If
            aux += 1
        End While
        Return (sum = numero)
    End Function


Saludos