SoloCodigo

Programación General => Visual Basic 6.0 e inferiores => Visual Basic para principiantes => Mensaje iniciado por: fraj en Viernes 8 de Mayo de 2009, 04:52

Título: Numeros perfecto
Publicado por: fraj en Viernes 8 de Mayo de 2009, 04:52
Ak de nuevo  con otro problemita
numeros perfectos  :me corre muy biem el programa lo malo q  solo me admite los 5 primeros numeros perfectos
osea :6, 28, 496, 8128, 33550336 Y no 8589869056 sale depurar
Código: Visual Basic
  1. Private Sub Cmdcalcular_Click()
  2. Dim numero As Long, sumas As Double, i As Long
  3.  
  4. numero = Val(Txtnu.Text)
  5. sumas = 0
  6. For i = 1 To numero - 1
  7.     If numero Mod i = 0 Then sumas = sumas + i
  8. Next
  9. If sumas = numero Then
  10.     Lblres.Caption = Str(numero) + " es un numero perfecto"
  11. Else
  12.    
  13.    Lblres.Caption = Str(numero) + " no es un numero perfecto"
  14.    End If
  15. End Sub
  16.  
  17.  
Q opcion me dan ustedes , o si seria mejor plantearlo de otra forma  :(
muchas gracias por su ayudaa  :)
Título: Re: Numeros perfecto
Publicado por: Nebire en Viernes 8 de Mayo de 2009, 09:01
Bueno, esto ya no es un problema de VB, esto es claramente un problema matemático, es decir un algoritmo... un problema independiente del lenguaje...

Lo que te falta es comprobar que el número que se ofrece como solución debe ser primo para que sea un número perfecto... to te propongo este sencillo algoritmo:

Código: Visual Basic
  1.  
  2. Private Sub Command1_Click()
  3.     Call NumPerfecto(10)
  4. End Sub
  5.  
  6. Public Function NumPerfecto(ByVal m As Long)
  7.    Dim k As Long, n As Double
  8.    For k = 2 To m
  9.         n = (2 ^ k) - 1
  10.         If EsPrimo(n) Then
  11.             ' entonces lo siguiente es numero perfecto
  12.             n = (2 ^ (k - 1)) * n
  13.             Print n;
  14.         End If
  15.    Next
  16. End Function
  17.  
  18. Private Function EsPrimo(ByVal n As Double) As Boolean
  19.     ' calcula o mejor comparalo con una tabla.... de primos
  20.     If n...... Then ' si n aparece en una tabla de primos entonces es primo
  21.         EsPrimo = True
  22.     End if
  23. End Function
  24.  
  25.  

Como verás sólo te falta añadir la comprobación de la condición de primo. lo más efectivo es usar una tabla de primos (calcular cada número es bastante lento), además para hacerlo más óptimo, puesto que en cada iteración el número a buscar es más grande, a la función es primo debería añadírsele un parámetro para que en base a él guardara el último lo calizado en la tabla y comenzar desde él o bien resetaearlo y empezar de nuevo.. te ilustro esa idea... (verás que la función esprimo2 ahora está completa, sólo falta la tabla que deberías cargar al inicio... si necesitas una tabla de primos, puedes probar a buscarla por internet, de todas formas creo recordar que tengo guardado en algún duisco duro tablas de hasta el primer millón de primos y otros archivos más pequeños...

Código: Visual Basic
  1.  
  2. Public Function NumPerfecto2(ByVal m As Long)
  3.    Dim k As Long, n As Double, v as double
  4.    
  5.     me.autoredraw=true
  6.     me.cls
  7.    Call EsPrimo2(1, True)  ' aquí reseteamos sin afectar en nada al resto, es decir hacemos que el static de esprimo2 'k' tome el valor 1
  8.    For k = 2 To m
  9.         v = (2 ^ k) - 1
  10.         If EsPrimo2(n) Then
  11.             ' entonces lo siguiente es numero perfecto
  12.             n = (2 ^ (k - 1)) * v
  13.             Print k, v, "=", n:
  14.         End If
  15.    Next
  16. End Function
  17.  
  18. Private Function EsPrimo2(ByVal n As Double, Optional Resetear As Boolean) As Boolean
  19.     Static k As Long ' eneavo nº consultado en la tabla
  20.    
  21.     If Resetear = True Then k = 1
  22.    
  23.     ' compara con una matriz de primos cargada al inicio
  24.     Do While tablaprimos(k) <= n
  25.         If n = tablaprimos(k) Then
  26.             EsPrimo2 = True
  27.             Exit Do
  28.         End if
  29.         k = k + 1
  30.     Loop
  31. End Function
  32.  
  33.  
En realidad dado que que pronto se alcanzan cifras muy grandes de n, incluso recorrer la tabla de primos continuando desde donde se quedó la última vez puede llegar a ser lento (depende de cuantos números quieras calcular, claro), y en dicho caso deberías modificar el algoritmo para hacer una detección más óptima ( por ejemplo utilizando marcadores sobre la tabla), pero de lo que trata el problema es de encontrar una solución y eso es lo que se hace... el resto queda a tu esfuerzo.

Si algo no lo entiendes, ya sabes, pregunta...
Título: Re: Numeros perfecto
Publicado por: fraj en Lunes 11 de Mayo de 2009, 01:49
:D  muchas gracias , x los ejerccios  :D  :D
Título: Re: Numeros perfecto
Publicado por: Jimbenit en Jueves 28 de Mayo de 2009, 21:16
La funcion:
EsPrimo:

Código: Visual Basic
  1.     Private Function EsPrimo(ByVal n As Long) As Boolean
  2.         Dim i As Integer
  3.         Dim Contador As Integer : Contador = 0
  4.  
  5.         'En caso de que el numero sea 1, indicara que es primo
  6.        If n = 1 Then
  7.             EsPrimo = True
  8.             Exit Function
  9.         End If
  10.  
  11.         'Contador cuenta el numero de submultiplos, desde el 1 hasta la mitad del numero
  12.        For i = 1 To Int(n / 2)
  13.             If (n Mod i) = 0 Then
  14.                 Contador = Contador + i
  15.             End If
  16.         Next i
  17.  
  18.         If Contador = 1 Then
  19.             EsPrimo = True
  20.         Else
  21.             EsPrimo = False
  22.         End If
  23.  
  24.  
  25.  
  26.     End Function
  27.  

 :P
Título: Re: Numeros perfecto
Publicado por: Jimbenit en Jueves 28 de Mayo de 2009, 23:23
Coloca un boton llamado command1
y pega este code:
Código: Visual Basic
  1. Private Function EsPrimo(ByVal n As Long) As Boolean
  2.         Dim i As Integer
  3.         Dim Contador As Integer: Contador = 0
  4.  
  5.         'En caso de que el numero sea 1, indicara que es primo
  6.         If n = 1 Then
  7.             EsPrimo = True
  8.             Exit Function
  9.         End If
  10.  
  11.         'Contador cuenta el numero de submultiplos, desde el 1 hasta la mitad del numero
  12.         For i = 1 To Int(n / 2)
  13.             If (n Mod i) = 0 Then
  14.                 Contador = Contador + i
  15.             End If
  16.         Next i
  17.  
  18.         If Contador = 1 Then
  19.             EsPrimo = True
  20.         Else
  21.             EsPrimo = False
  22.         End If
  23.  
  24.  
  25.     End Function
  26.  
  27.     Private Function Nro_Primos(ByRef Vector() As Long, ByVal Lim_Sup As Integer) As String
  28.         'Esta funcion devuelve una cadena de numeros primos colocados en columna.
  29.         Dim i As Integer
  30.         ReDim Vector(1)
  31.         Dim Contador As Integer: Contador = 0
  32.         Dim Texto As String: Texto = ""
  33.  
  34.         For i = 1 To Lim_Sup
  35.  
  36.             If EsPrimo(i) Then
  37.                 ReDim Preserve Vector(i)
  38.                 Contador = Contador + 1
  39.                 Vector(Contador) = i
  40.                 Texto = Texto & i & vbCrLf
  41.             End If
  42.  
  43.         Next i
  44.  
  45.         Nro_Primos = Texto
  46.  
  47.     End Function
  48.  
  49. Private Sub Command1_Click()
  50. Dim Vect() As Long
  51.  
  52. MsgBox (Nro_Primos(Vect, 100))
  53.  
  54. End Sub
  55.  

Te aparece la lista de numeros primos... :lol:  :lol:  :lol:  :lol:
Título: Re: Numeros perfecto
Publicado por: m0skit0 en Viernes 29 de Mayo de 2009, 10:11
Jimbenit, me vas a perdonar, pero tu función EsPrimo está mal codificada. ¿Para qué quieres seguir buscando "submúltiplos" (supongo que querrás decir divisores) si al encontrar uno ya sabemos que el número no es primo? ¿Además, para qué conviertes el número en Integer cuando lo aceptas como Long en el parámetro?

Código: Visual Basic
  1. Private Function EsPrimo(ByVal N as Long) As Boolean
  2.     Dim i As Long
  3.     Dim Mitad As Long
  4.    
  5.     EsPrimo = True
  6.     i = 2
  7.     Mitad = N/2
  8.     Do While (i <= Mitad) And EsPrimo
  9.         If (N mod i = 0) Then
  10.             EsPrimo = False
  11.         Else
  12.             i = i + 1
  13.         End If
  14.     Loop
  15. End Function
  16.  
Además, en tu función Nro_Primos creas un vector con tamaño Lim_Sup, cuando los primos son evidentemente muchos menos que Lim_Sup. Así desperdicias mucha memoria y eso es una mala práctica. Tendrías que poner:

Código: Visual Basic
  1. If EsPrimo(i) Then
  2.     Contador = Contador + 1
  3.     ReDim Preserve Vector(Contador - 1)    
  4.     Vector(Contador - 1) = i
  5.     Texto = Texto & i & vbCrLf
  6. End If
  7.  
Saludos y  :comp:
Título: Re: Numeros perfecto
Publicado por: Jimbenit en Viernes 29 de Mayo de 2009, 16:06
Cita de: "m0skit0"
Jimbenit, me vas a perdonar, pero tu función EsPrimo está mal codificada. ¿Para qué quieres seguir buscando "submúltiplos" (supongo que querrás decir divisores) si al encontrar uno ya sabemos que el número no es primo? ¿Además, para qué conviertes el número en Integer cuando lo aceptas como Long en el parámetro?

Código: Visual Basic
  1. Private Function EsPrimo(ByVal N as Long) As Boolean
  2.     Dim i As Long
  3.     Dim Mitad As Long
  4.    
  5.     EsPrimo = True
  6.     i = 2
  7.     Mitad = N/2
  8.     Do While (i <= Mitad) And EsPrimo
  9.         If (N mod i = 0) Then
  10.             EsPrimo = False
  11.         Else
  12.             i = i + 1
  13.         End If
  14.     Loop
  15. End Function
  16.  
Además, en tu función Nro_Primos creas un vector con tamaño Lim_Sup, cuando los primos son evidentemente muchos menos que Lim_Sup. Así desperdicias mucha memoria y eso es una mala práctica. Tendrías que poner:

Código: Visual Basic
  1. If EsPrimo(i) Then
  2.     Contador = Contador + 1
  3.     ReDim Preserve Vector(Contador - 1)    
  4.     Vector(Contador - 1) = i
  5.     Texto = Texto & i & vbCrLf
  6. End If
  7.  
Saludos y  :comp:
Si, tienes razón...
 :lol:  :lol:  :lol: Veo que mi respuesta fue un poco a la ligera....  :lol:  :lol:  :lol:  
Mi respuesta fue solo para dar una idea...
A la próxima lo pienso un poquito mas...
Saludos Mosquito...
Título: Re: Numeros perfecto
Publicado por: STROKERT en Domingo 15 de Noviembre de 2009, 04:19
PORFAS AYUDA CON ESTE ALGORITMO!
CHEQUENLO SI ESTA BIEN Y ME DICEN EN DONDE ESTA MAL PORFAS!
 Diseñar un algoritmo que me permita calcular los 5 primeros números perfecto (un número es perfecto, cuando la suma de sus divisores, sin incluirlo al número es exactamente el mismo número). El 6 es un número perfecto ya que sus divisores son 1,2 y 3 suman 6. La solución hace que el computador tome un buen tiempo para completar los 5 números.

CLS

Num = 5

C = 0

DO WHILE C < 5

        Num = Num + 1

        Suma = 0

               FOR i = 1 TO INT(Num / 2)

                       IF Num MOD i = 0 THEN

                              Suma = Suma + i

                       END IF

               NEXT

               IF Num = Suma THEN

                       C = C + 1

                       PRINT "El Numero", Num

               END IF

LOOP
Título: Re: Numeros perfecto
Publicado por: Nebire en Lunes 16 de Noviembre de 2009, 15:11
El algoritmo es totalmente correcto. Adolece simplemente de que es lento.
Es lento porque le pides que calcule todos los divisores posibles para un número contando desde 1 hasta la mitad del número a calcular...

Ejecutando el código obtengo estos valores:

Código: Text
  1.  
  2. Nº Perfecto ______Timer_______iteraciones (valor absoluto)
  3. 6             48265.89           3
  4. 28            48265.89           190
  5. 496           48266          61498
  6. 8128          48401.82       16516090
  7.  
Como ves a cada hallazgo el número de iteraciones crece exponencialmente. El siguiente número es  33550336, si en mi ordenador quickbasic ha tardado 35 segundos para hallar el 8128, para hallar el 33.550.336 a 'grosso modo' podría tardar 6 días.

Este ejercicio te lo ponen no para probar que eres capaz de encontrar una solución, sino para probar cuan eficaz eres en encontrar una solución. Es un ejercicio excelente para demostrar que la 'fuerza bruta' resulta ineficaz o por lo menos te cuestiona sobre si debe o no buscarse un método alternativo más eficaz.

La solución de este algoritmo ya la expliqué más arriba. La eficacia del mismo se reduce a con qué velocidad podemos hallar números primos. sin embargo para qué hallar números primos cuando ya se conocen tablas ?.

Ahora bien si parte del problema lo escalcular los primos, no te dejarán usar una tabla de primos desde fichero. Por tanto, lo ideal será dividir el algoritmo en 2 partes.

En la 1ª parte (que más adelante lo sugerimos como la 3ºfunción) se debería calcular una tabla de primos lo suficientemente grande como para 'alcanzar' al 5º número  buscado. Como a priori no  sabríamos cual es ese valor, lo adecuado sería calcular primos en rondas condicionales según se vayan necesitando, los primos hallados se deberían meter en una matriz. por ejemplo calculamos los primos existentes hasta el número solicitado, luego localizamos si el 5º número perfecto se puede hallar en ese rango, si no se encuentra buscamos primos hasta la siguiente tanda, se añaden a una matriz, nuevamente verificamos si el 5º númeroperfecto se sencuentra en la matriz ... repetimos el cilcoo hasta que se encuentre. Por supuesto puedes alterar el código sugerido para que por ejemplo busque cada 1000 primos ú otro sistema que prefieras... yo en ese sentido sólo te ofrezco una sugerencia de solución.

en seudocódigo sería algo como...
Previamente decidimos dividir la búsqueda de primos 'sobre la marcha', para ello necesitamos algunas variables que nos permitan controlar estos condicionantes:

Código: Text
  1. Primos() ' Matriz de alojamiento de los primos hallados
  2. Primos(0 to 999) ' Redimensionar la matriz cada 1000 hallados, la matriz es dinámica y acabamos de darle 1000 elementos
  3. NPrimos ' contiene números primos hallados, aunque la matriz tenga 1000 elementos nPrimos indica cuantos elementos realmente están ocupados
  4.  
  5. BuscarnumerosPerfectos(Cuantos) no devuelve nada
  6.     Primos(0)=1
  7.     Primos(1)=2
  8.     NPrimos =2
  9.     iniciar bucle BuscarPerfectos 2, cuantos
  10.          candidato= (2^BuscarPerfectos ) -1
  11.         si EsPrimoBuscarEnMatriz(candidato)=true luego
  12.                 NumPerfecto= (2^ (BuscarPerfectos -1)) * candidato
  13.                 print NumPerfecto,
  14.         fin si
  15.     fin Bucle
  16. fin BuscarnumerosPerfectos
  17.  
  18.  
  19. EsPrimoBuscarEnMatriz(Candidato) tipo buleano
  20.    PrimoMayorEnMatriz  =  matriz( NPrimos-1)
  21.    hacer mientras PrimoMayorEnMatriz < candidato
  22.         llamar a la función BuscarPrimos(LimiteMayorActualDeLaMatriz, int(SQR(candidato)))
  23.         PrimoMayorEnMatriz  =  matriz( NPrimos-1)
  24.    repetir  
  25.    
  26.     iniciar bucle LocalizarPrimoEnMatriz 2, LimiteMayorActualDeLaMatriz
  27.            si candidato= primos(LocalizarPrimoEnMatriz) luego
  28.                     devolver EsPrimoBuscarEnMatriz=true
  29.                     salir de la función
  30.            fin si
  31.     fin bucle
  32.      ' si llega aquí devolver false
  33. fin función EsPrimoBuscarEnMatriz
  34.  
  35.  
  36. BuscarPrimos(desde, hasta)
  37.    si desde es par, le añadimos 1, porque excepto el 2 el resto de primos es impar.
  38.    iniciar bucle Recorrido desde, hasta en pasos de 2
  39.          n=Recorrido
  40.         EsPrimo = true  '
  41.         ' buscar divisores, un búmero no es primos si tiene divisores diferentes de 1 y sí mismo
  42.         iniciar bucle CalcularSiNEsPrimo:  2, int(sqr(n))
  43.              si n mod CalcularSiNEsPrimo = 0 es divisor luego EsPrimo=false, salir del bucle  
  44.         siguiente en el bucle
  45.  
  46.        si EsPrimo = true luego meterlo en la matriz  
  47.            nPrimos= nPrimos +1
  48.            Primos(nPrimos)= n
  49.        fin si
  50.        
  51.       si matriz esta llena redimensionamos conservando contenido, en otros 1000 elementos más
  52.    fin bucle recorrido
  53. fin función BuscarPrimos
  54.  

Comentando el código...

1 - entramos en una función, o sub, (si no sabes tratar funciones y subs en QuickBasic (o QBasic) trátalo gono una etiqueta... al final te aclaro esto) que va a localizar los números perfectos deseados. Para ello invoca a una función que determina si un número candidato a número perfecto es primo, si dicho número es primo, hay un número que se deduce como número perfecto partiendo de dicho candidato.

2 - La función es primo, primero verifica si la matriz de primos tiene contenido (de entrada sólo fijamos 2 primos en la rutina anterior (1 y 2)) si el último primo es menor que el candidato significa que puede no bastarnos con los primos que tenemos en la matriz actual para determinar si el candidato es primo, por tanto llamamos a la función que comentaremos después para localizar más primos y meterlos en la matriz. Después lo único que hacemos es recorrer la matriz y ver si el candidato está en la matriz, si está es primo si no no. Este resultado es lo que devuelve esta función.

3 - La 3ª función localiza primos, a partir del valor indicado (el último que tenemos almacenado en la matriz) hasta la raíz  cuadrada del  candidato actual, cada vez que se halla uno se añade a la matriz y se totaliza la cantidadde primos hallados. Si la matriz  se llena se redimensiona con otros 1000 elementos más (preservando su contenido), esto se hace 1 vez con 1000 elementos no tras cada primo hallado que sería muy lento.

Finalmente, si no sabes manejar funciones y rutinas en QuickBasic-QBasic siempre se puede 'simular' con etiquetas y saltos entre ellas. He aquí un ejemplo sencillo:
Código: Visual Basic
  1.  
  2.  
  3. Perfectos:   ' esto es una etiqueta
  4. ' se coloca aquí el código de la 1ª función
  5.  
  6. ' donde se señala: si EsPrimoBuscarEnMatriz(candidato)=true luego , hacemos previamente un salto
  7. gosub EsPrimoBuscarEnMatriz ' y luego cambiamos dicha línea por:
  8. si EsPrimo=true luego
  9. ' resto del código
  10.  
  11. End  ' el programa termina al llegar aquí
  12.  
  13. ' esto es otra etiqueta, se puede saltar aquí con gosub nombreetiqueta
  14. EsPrimoBuscarEnMatriz :
  15.      ' aquí se coloca el código de la 2ª función
  16.  
  17.      ' donde pone: llamar a la función BuscarPrimos(....) ' previamente ponemos estas líneas
  18.     Desde = LimiteMayorActualDeLaMatriz
  19.     Hasta = int(SQR(candidato)))
  20.      ' luego sustituímos dicha línea de llamada por esta otra
  21.      gosub  BuscarPrimos
  22.      'resto del código
  23. Return
  24.  
  25. BuscarPrimos :
  26.    ' código de la 3ª función
  27. Return
  28.  
  29.  
Una etiqueta, es como un punto de entrada a una función, y 'Return' es como el punto de salida que devuelve el control a la línea siguiente a la que invocó la etiqueta, para tratarse como una rutina debe usarse gosub, goto produce un salto incondicional sin esperar retorno, porlo que aparecería un error si se salta a una etiqueta usando goto y se encuentra un return diciendo algo como (Return sin Gosub ???)...

Ya depende de tu pericia del lenguaje que estimo no va muy allá... pero bueno progresa y ya nos contarás donde te estancas...

p.d.: en quickbasic para trabajar con matrices dinámicas (que superen los 64Kb), es necesario arrancarlo con los siguientes parámetros en la línea de comando: Unidad:qb45QB.EXE /ah
Donde unidad es la letra del disco donde está la carpeta qb45 , nota el parámetro "/ah"