Test Foro de elhacker.net SMF 2.1

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

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

La función es correcta si devuelve:
4613732

Estructura a seguir:
Private Function NOMBREFUNCION(Optional lLimit As Long = 4000000) As Long

DoEvents! :P

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


Correjido

Private Function Fibonacci() As Long
Dim a As Long, b As Long, c As Long, x As Long: x = &H4
a = 0
b = 0
c = 0
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:
end Function



Saludos

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:
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í:
Dim a As Long, b As Long, c As Long

DoEvents! :P

Cita de: Psyke1 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 (vb) [Seleccionar] Expandir

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 (vb) [Seleccionar] Expandir

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.

Private Sub Form_Load()
Dim x, y As Long
x = 4613732
MsgBox (VarType(y) = vbLong)
End Sub


Seguro que abarca los bytes de un tipo Variant?

CitarSeguro que abarca los bytes de un tipo Variant?

Si  :)

Private Sub Form_Load()
   Dim x, y As Long
   x = 4613732
   y = 4613732
   MsgBox LenB(x) & " bytes"
   MsgBox LenB(y) & " bytes"
End Sub

Cita de: rob1104 en 24 Enero 2013, 22:03 PM
Si  :)

Código (vb) [Seleccionar] Expandir

Private Sub Form_Load()
   Dim x, y As Long
   x = 4613732
   y = 4613732
   MsgBox LenB(x) & " bytes"
   MsgBox LenB(y) & " bytes"
End Sub

Gracias.

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

Edito mi código. saludos

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

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

Function robEuler2() As Long
   Dim f1 As Long, f2 As Long, contador As Long, resultado As Long, suma As Long
   f1 = 0
   f2 = 1
   resultado = f1 + f2
   Do While suma < 4000000
       f1 = f2 + resultado
       resultado = f2
       f2 = f1
       contador = contador + 1
       If f2 Mod 2 = 0 Then
           suma = suma + f2
       End If
   Loop
   robEuler2 = suma
End Function

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

Aquí dejo la mía:

Private Static Function Psk1_PE2(Optional lLimit As Long = &H3D0900) As Long
Dim Q1 As Long
Dim Q2 As Long
Dim Q3 As Long
   
    If lLimit And &H80000000 Then Exit Function

   Q1 = &H1
    Q2 = &H1
    Q3 = &H2
   
   Do While Q3 < lLimit
       Psk1_PE2 = Psk1_PE2 + Q3
       
       Q1 = Q2 + Q3
       Q2 = Q1 + Q3
       Q3 = Q2 + Q1
   Loop
End Function

DoEvents! :P

Demasiados números me servirán para una jaqueca...

Dulces Lunas!¡.

Psyke ya ha encontrado la solución óptima, porque tal y como apunta @imoen cada 3er número de Fibonacci es par...

HOLA!!!

Aqui una respuesta simple, ando sin time para hacer algo mejor:
Private Function Fibbo7913(Optional Limit As Long = 4000000) As Long
Dim aux  As Long
Dim act  As Long
Dim ant  As Long
Dim suma As Long
    ant = 1
    act = 1
    suma = 1
    Do
        If act And 1 Then suma = suma + act 'operacion binaria que me dice si es par o no
        aux = act
        act = act + ant
        ant = aux
    Loop While act < Limit
    Fibbo7913 = suma
End Function


P.D: esto me hace recordar a: [RETO] IsFibonacciNumber(N as long) (http://foro.elhacker.net/empty-t319480.0.html)

GRACIAS POR LEER!!!

Hola


Bueno os comento
Nadie me hace caso usar un array de 3 elementos :P

79137913->   codigo muy clarito y funcional ,

Psyke1-> premiooo,  es el código mas rápido seguramente , lo del aspersan eran punteros ?¿?¿ que no me acuerdo muy bien jeje, jeje al menos me ha hecho caso con la numeración par xDD

rob114->[quotecomo ni a mí ni a mi core 2 duo nos importa la velocidad][/quote] , deberia de importar , y has abierto el cajon

Y si aplicamos recursividad a este reto  ?¿

Al final veo que me instalo el visual basic XDD otro reto mas y lo tengo que poner ehh xDD

bs imoen

@79137913
¡Tu función devuelve un array! :laugh:

Además, no devuelve el resultado deseado:
Private Sub Form_Load()
   Debug.Print Fibbo7913
End Sub


524288 '// debería de ser: 4613732

También recuerdo que debe de funcionar correctamente contemplando todas las posibilidades.

---

@imoen
¿Un array de 3 elementos? ¿Qué conseguiríamos con eso? :rolleyes:
Lo del &H sirve para indicar que el número que va a continuación está en base 16.
Y la recursividad está bien para ahorrar código, pero es leeeenta... :-\

DoEvents! :P

HOLA!!!

Psyke1: Tenes razon, habia un error en mi procedimiento, al corregirlo me di cuenta que el procedimiento de todos estaba errado tambien, dejo mi funcion actualizada en el primer post.
Aclaro aca bien cual es el resultado correcto (que no es el que decis vos por que tiene que ser menor al limite.)

Generar algoritmo que devuelva la suma de los números de la serie de Fibonacci, y esa suma sea menor a 4000000. PSYKE1 TRADUCI BIEN

RTA correcta:
3524577

GRACIAS POR LEER!!!

Segun las soluciones es 4613732


esta es la formula de la mio.

B=2
A=Ax4+B
B=A

obviamente tengo que conocer el limite para obtener bien el resultado.

Igual aquí dejo uno mas valido.

Actualizado
Private Function fb(Optional lLimit As Long = 4000000) As Long
Dim fn As Long, f1 As Long, f2 As Long
If lLimit And &H80000000 Then Exit Function
f1 = 1
f2 = f1
Do While f2 < lLimit
fn = f1 + f2
f1 = f2
f2 = fn
If fn Mod 2 = 0 Then
fb = fb + fn
End If
Loop
End Function

Saludos

Disculpad, cometí una errata a la hora de describir el reto.
Post uno actualizado. :-*

PD: ¿Voy poniendo ya el reto 3? :xD

DoEvents! :P

Cita de: Psyke1 en 25 Enero 2013, 13:49 PM
Disculpad, cometí una errata a la hora de describir el reto.
Post uno actualizado. :-*

PD: ¿Voy poniendo ya el reto 3? :xD

DoEvents! :P

Yo creo que si.  ;-)

la solucion mas rapida en cualquier lenguaje, es precargar los numeros ya calculados en un array y simplemente recorrer este y sumar los pares.

Cita de: seba123neo en 25 Enero 2013, 14:15 PM
la solucion mas rapida en cualquier lenguaje, es precargar los numeros ya calculados en un array y simplemente recorrer este y sumar los pares.

La más rápida es sacar el resultado precalculado con un print :P

Cita de: Karcrack en 25 Enero 2013, 15:07 PM
La más rápida es sacar el resultado precalculado con un print :P

Exactamente!¡.

P.D.: @Psyke1 aun no se va dolores ¿Que hago con ella?.

Dulces Lunas!¡.

Cita de: Karcrack en 25 Enero 2013, 15:07 PM
La más rápida es sacar el resultado precalculado con un print :P

¡Qué buena idea! :D
¡aquí dejo mi última versión! :xD


Option Explicit

'by psyke1
'creditos a karcrack
'25/01/13

Private Static Function Psk_v2(Optional ByVal lLimit As Long = &H3D0900) As Long
Dim q As Long
Dim r As Long
Dim tg As Long
Dim w As Long
Dim Q2 As Long
Dim matriz() As Long
   
   tg = &HDF98
   r = &HA
   For q = 0 To &HF
       r = r + &HA
   Next q
   
   tg = tg Xor r
   r = tg Xor r
   tg = tg Xor r
   
   lLimit = lLimit + &H345
   
   Do While w: w = w - Val(w): Loop
   
   If Not r And &H1 Then
       Psk_v2 = ChrW(&H34) & ChrW(54)
       
       If w = 0 Then
           lLimit = lLimit - &H345
           lLimit = lLimit \ 5
           Psk_v2 = Psk_v2 & CStr(&H35A4)
           
           If ((lLimit * &H5) <> &H3D0900) And Not (&H1 + &H3 = &H5) Then
               Psk_v2 = Psk_v2 - &H29 + &H93
               Do: Beep: DoEvents: DoEvents: Loop
           End If
       Else
           Psk_v2 = (((w And &HFF000000) \ &H1000000) And &HFF&) Or _
               ((w And &HFF0000) \ &H100&) Or _
               ((w And &HFF00&) * &H100&) Or _
               (Val(w And &H7F&) * &H1000000) Xor tg
       End If
   Else
       Q2 = Q2 ^ 5 * Val(Str(9873)) And tg
   End If
End Function


Si hago esto:
Private Sub Form_Load()
   Debug.Print Psk_v2
End Sub

Devuelve esto:
4613732

Es mucho más rápida. ¿alguien podría probar con otro número? :silbar:

---

@BlackZeroX

Esperemos que dolores se vaya antes que Euler, porque aún nos quedan 409 retos. :laugh:

DoEvents! :P

@Psyke1

cuando no le pongo parámetro funciona bien. pero cuando le paso otro parametro no funciona y me hace sonar las bocinas con beeps :S

saludos