elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Arreglado, de nuevo, el registro del warzone (wargame) de EHN


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  [RETO] Project Euler 2
0 Usuarios y 2 Visitantes están viendo este tema.
Páginas: [1] 2 3 Ir Abajo Respuesta Imprimir
Autor Tema: [RETO] Project Euler 2  (Leído 10,960 veces)
Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.089



Ver Perfil WWW
[RETO] Project Euler 2
« en: 24 Enero 2013, 19:05 pm »

Generar algoritmo que devuelva la suma de los números pares de la serie de Fibonacci menores a 4000000.

Info:
Código:
http://projecteuler.net/problem=2
http://es.wikipedia.org/wiki/Sucesi%C3%B3n_de_Fibonacci

La función es correcta si devuelve:
Código:
4613732

Estructura a seguir:
Código
  1. Private Function NOMBREFUNCION(Optional lLimit As Long = 4000000) As Long

DoEvents! :P


« Última modificación: 3 Febrero 2013, 16:22 pm por Psyke1 » En línea

Danyfirex


Desconectado Desconectado

Mensajes: 493


My Dear Mizuho


Ver Perfil
Re: [RETO] Proyect Euler 2
« Respuesta #1 en: 24 Enero 2013, 20:31 pm »

Bueno aquí dejo la mía. un Poco larga :silbar: pero funciona.  ;D


Correjido

Código
  1. Private Function Fibonacci() As Long
  2. Dim a As Long, b As Long, c As Long, x As Long: x = &H4
  3. a = 0
  4. b = 0
  5. c = 0
  6. a = (a * x) + 2: Fibonacci = Fibonacci + a: b = a: a = (a * x): Fibonacci = Fibonacci + a: c = a: a = (a * x) + b: Fibonacci = Fibonacci + a: b = a: a = (a * x) + c: Fibonacci = Fibonacci + a: c = a: a = (a * x) + b: Fibonacci = Fibonacci + a: b = a: a = (a * x) + c: Fibonacci = Fibonacci + a: c = a: a = (a * x) + b: Fibonacci = Fibonacci + a: b = a: a = (a * x) + c: Fibonacci = Fibonacci + a: c = a: a = (a * x) + b: Fibonacci = Fibonacci + a: b = a: a = (a * x) + c: Fibonacci = Fibonacci + a: c = a: a = (a * x) + b: Fibonacci = Fibonacci + a:
  7. end Function
  8.  


Saludos


« Última modificación: 24 Enero 2013, 22:11 pm por Danyfirex » En línea

Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.089



Ver Perfil WWW
Re: [RETO] Proyect Euler 2
« Respuesta #2 en: 24 Enero 2013, 20:49 pm »

Como no organices mejor el código no nos vamos a enterar de nada. :silbar: No abuses tanto de los ":".

Y te informo que haciendo esto:
Código
  1. Dim a, b, c As Long
Sólo declaras la última variable como Long, las otras, como no has puesto nada, por defecto serían Variant, que ocupa memoria innecesariamente.
Sería así:
Código
  1. Dim a As Long, b As Long, c As Long

DoEvents! :P
En línea

Danyfirex


Desconectado Desconectado

Mensajes: 493


My Dear Mizuho


Ver Perfil
Re: [RETO] Proyect Euler 2
« Respuesta #3 en: 24 Enero 2013, 20:55 pm »

Como no organices mejor el código no nos vamos a enterar de nada. :silbar: No abuses tanto de los ":".

Y te informo que haciendo esto:
Código
  1. Dim a, b, c As Long
Sólo declaras la última variable como Long, las otras, como no has puesto nada, por defecto serían Variant, que ocupa memoria innecesariamente.
Sería así:
Código
  1. Dim a As Long, b As Long, c As Long

DoEvents! :P

No sabia eso.  Gracias Psyke1. y perdon por el abuso de los :.

gracias Corrijo el código.

saludos



EDITO:

Comprobé asi y me dice que es long.

Código
  1. Private Sub Form_Load()
  2. Dim x, y As Long
  3. x = 4613732
  4. MsgBox (VarType(y) = vbLong)
  5. End Sub
  6.  

Seguro que abarca los bytes de un tipo Variant?
« Última modificación: 24 Enero 2013, 21:04 pm por Danyfirex » En línea

rob1104


Desconectado Desconectado

Mensajes: 340


Usuario común


Ver Perfil WWW
Re: [RETO] Proyect Euler 2
« Respuesta #4 en: 24 Enero 2013, 22:03 pm »

Citar
Seguro que abarca los bytes de un tipo Variant?

Si  :)

Código
  1. Private Sub Form_Load()
  2.    Dim x, y As Long
  3.    x = 4613732
  4.    y = 4613732
  5.    MsgBox LenB(x) & " bytes"
  6.    MsgBox LenB(y) & " bytes"
  7. End Sub
En línea

Sin análisis de requisitos o sin diseño, programar es el arte de crear errores en un documento de texto vacío.
Danyfirex


Desconectado Desconectado

Mensajes: 493


My Dear Mizuho


Ver Perfil
Re: [RETO] Proyect Euler 2
« Respuesta #5 en: 24 Enero 2013, 22:10 pm »

Si  :)

Código
  1. Private Sub Form_Load()
  2.    Dim x, y As Long
  3.    x = 4613732
  4.    y = 4613732
  5.    MsgBox LenB(x) & " bytes"
  6.    MsgBox LenB(y) & " bytes"
  7. End Sub

Gracias.

ya alargue el tema con mis preguntas y respuestas tontas  :silbar:

Edito mi código. saludos
En línea

imoen


Desconectado Desconectado

Mensajes: 1.589



Ver Perfil
Re: [RETO] Proyect Euler 2
« Respuesta #6 en: 24 Enero 2013, 22:21 pm »

hola

Si si no le pones tipo la declaracion automatica es variant.
Otra cosa si declarais en vez de 3 variables , un array de 3 elementos ?¿ no sale mas rentable y asi lo podeis usar en los  bucles?¿

bs imoen
En línea

Medion Akoya p6624
i-3 370
8 gigas DDR 3 RAM //750 hd 5400
gforce gt425 optimus XDD
Esta es mi casa, mi pueblo , o lo que queda de el aun asi lucharemos ... POR BENALIA....!!

srta imoen
rob1104


Desconectado Desconectado

Mensajes: 340


Usuario común


Ver Perfil WWW
Re: [RETO] Proyect Euler 2
« Respuesta #7 en: 24 Enero 2013, 22:22 pm »

Pues bueno, como ni a mí ni a mi core 2 duo nos importa la velocidad y ademas que no tocaba vb6 desde hace mas de 2 años pues seguiré los codigos para ir practicando, no sean tan destructivos  :P

Código
  1. Function robEuler2() As Long
  2.    Dim f1 As Long, f2 As Long, contador As Long, resultado As Long, suma As Long
  3.    f1 = 0
  4.    f2 = 1
  5.    resultado = f1 + f2
  6.    Do While suma < 4000000
  7.        f1 = f2 + resultado
  8.        resultado = f2
  9.        f2 = f1
  10.        contador = contador + 1
  11.        If f2 Mod 2 = 0 Then
  12.            suma = suma + f2
  13.        End If
  14.    Loop
  15.    robEuler2 = suma
  16. End Function
En línea

Sin análisis de requisitos o sin diseño, programar es el arte de crear errores en un documento de texto vacío.
imoen


Desconectado Desconectado

Mensajes: 1.589



Ver Perfil
Re: [RETO] Proyect Euler 2
« Respuesta #8 en: 24 Enero 2013, 22:33 pm »

HOla

Codigo muy clarito, una pregunta , la sucesion de fibonacci tiene pares cada 4 y 3 numeros os puede ayudar eso para no tener que divir  y optimizar codigo XD

bs imoen
En línea

Medion Akoya p6624
i-3 370
8 gigas DDR 3 RAM //750 hd 5400
gforce gt425 optimus XDD
Esta es mi casa, mi pueblo , o lo que queda de el aun asi lucharemos ... POR BENALIA....!!

srta imoen
Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.089



Ver Perfil WWW
Re: [RETO] Proyect Euler 2
« Respuesta #9 en: 25 Enero 2013, 00:34 am »

Aquí dejo la mía:
Código
  1. Private Static Function Psk1_PE2(Optional lLimit As Long = &H3D0900) As Long
  2. Dim Q1 As Long
  3. Dim Q2 As Long
  4. Dim Q3 As Long
  5.  
  6.    If lLimit And &H80000000 Then Exit Function
  7.  
  8.    Q1 = &H1
  9.    Q2 = &H1
  10.    Q3 = &H2
  11.  
  12.    Do While Q3 < lLimit
  13.        Psk1_PE2 = Psk1_PE2 + Q3
  14.  
  15.        Q1 = Q2 + Q3
  16.        Q2 = Q1 + Q3
  17.        Q3 = Q2 + Q1
  18.    Loop
  19. End Function

DoEvents! :P
« Última modificación: 25 Enero 2013, 13:43 pm por Psyke1 » En línea

Páginas: [1] 2 3 Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
Projecto Euler problema 12
Ejercicios
lDanny 5 5,436 Último mensaje 16 Octubre 2010, 04:33 am
por [L]ord [R]NA
[RETO] Project Euler 1 « 1 2 3 4 5 »
Programación Visual Basic
Psyke1 42 21,679 Último mensaje 26 Enero 2013, 11:20 am
por imoen
[RETO] Project Euler 3 « 1 2 »
Programación Visual Basic
Psyke1 13 6,976 Último mensaje 3 Febrero 2013, 20:45 pm
por imoen
[RETO] Project Euler 4 « 1 2 »
Programación Visual Basic
Psyke1 10 6,109 Último mensaje 4 Febrero 2013, 23:32 pm
por imoen
Ayuda con el calculo de Pi por la Serie de Euler
Programación C/C++
Rollingman216 3 2,203 Último mensaje 24 Agosto 2017, 04:09 am
por engel lex
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines