[RETO] IsFibonacciNumber(N as long) as Boolean

Iniciado por 79137913, 14 Febrero 2011, 19:42 PM

0 Miembros y 1 Visitante están viendo este tema.

BlackZeroX

#10
.
@Mr. Frogs

Tu funcion tiene Horrores de logica básica ( Conversion de un Double a un Integer ).

Aquí la mía (Aplicando algo que dijo seba123neo pero en la forma mas practica posible para el ahorro de memoria) :

Código (Vb) [Seleccionar]


Option Explicit

Function isFibbonacci(ByVal vVal&) As Boolean
Dim dbl_v#(0 To 1)
Dim byt_i                   As Byte
    If Not vVal& And &H80000000 Then
        dbl_v#(1) = 1
        dbl_v#(0) = 0
        Do Until dbl_v#(byt_i) >= vVal&
            dbl_v#(byt_i) = dbl_v#(byt_i) + dbl_v#(byt_i Xor 1)
            byt_i = byt_i Xor 1
        Loop
        If dbl_v#(0) = vVal& Or dbl_v#(1) = vVal& Then
            isFibbonacci = True
        End If
    End If
End Function

Private Sub Form_Load()
Dim lng_i&
   For lng_i& = -214748 To 2147483647
       If isFibbonacci(lng_i&) = True Then
           Debug.Print lng_i&
       End If
   Next lng_i&
End Sub





0
1
2
3
5
8
13
21
34
55
89
144
233
377
610
987
1597
2584
4181
6765
10946
17711
28657
46368
75025
121393
196418
317811
514229
832040
1346269
2178309
3524578
5702887
9227465
14930352
24157817
39088169
63245986
102334155
165580141
267914296
433494437
701408733
1134903170
1836311903



P.D.: DarkMatrix tu juego aun esta Online, cual es la pagina?

Temibles Lunas!¡.
The Dark Shadow is my passion.

79137913

#11
HOLA!!!

Aca va mi codigo, Casi identico al de Mr Frog :S igual Lo tenia armado desde antes.

Me falta agregar la comprobacion para los negativos.

Código (vb) [Seleccionar]
Private Function IsFibonacci7913(ByVal N As Long) As Boolean
   If N < &H0 Then
   If N = -1 Then IsFibonacci7913 = True: Exit Function
        Dim Neg0 As Double
        Dim Neg1 As Double
        Dim Neg2 As Double
       Neg0 = &H0
       Neg1 = &H1
       Do While Not (Neg1 < N)
           Neg2 = Neg0
           Neg0 = Neg1
           Neg1 = (Neg2 - Neg0)
       Loop
       If N = Neg2 Then IsFibonacci7913 = True
       Exit Function
   End If
   If N = &H0 Then IsFibonacci7913 = True: Exit Function
    Dim Aux0 As Double
    Dim Aux1 As Double
    Dim Aux2 As Double
   Aux2 = N * N
   Aux2 = Aux2 + Aux2 + Aux2 + Aux2 + Aux2
   Aux1 = Aux2 + &H4
   Aux1 = Sqr(Aux1)
   If Aux1 - (CLng(Aux1)) = &H0 Then IsFibonacci7913 = True: Exit Function
   Aux0 = Aux2 - &H4
   Aux0 = Sqr(Aux0)
   If Aux0 - (CLng(Aux0)) = &H0 Then IsFibonacci7913 = True
End Function


Nota:
1)Negafibonacci (ver fuente).
2)Comprobacion de Numeros enteros positivos sean de Fibbonacci (ver fuente).

Fuente1: http://www.worldlingo.com/ma/enwiki/es/Negafibonacci
Fuente2: http://gaussianos.com/algunas-curiosidades-sobre-los-numeros-de-fibonacci/

GRACIAS POR LEER!!!
"Como no se puede igualar a Dios, ya he decidido que hacer, ¡SUPERARLO!"
"La peor de las ignorancias es no saber corregirlas"

79137913                          *Shadow Scouts Team*

Psyke1

#12
Mi función y la de 79137913 solo es valida hasta 46340... (estoy trabajando en ello) :rolleyes:

@79137913
Las varibles donde estan declaradas? :huh:

@BlackZer0x
CitarTu funcion tiene Horrores de logica básica ( Conversion de un Double a un Integer ).
Creo que te equivocas, lo que hago es comprobar si el resultado es un número exacto o no, de esta manera :

Si tengo el numero 234.365 seria :
Código (vb) [Seleccionar]

234.365 - 234 = 0 ' Falso (el número 234.365 NO es entero)

Pero si es el numero 456 :
Código (vb) [Seleccionar]

456 - 456 = 0 ' Verdadero (el número 456 es entero)


DoEvents! :P

79137913

#13
HOLA!!!

Hasta ahora:
0) SOLO TESTEADO CON NUMEROS POSITIVOS
1) A MI FUNCION EN EL TEST SE LE QUITO LA PARTE DE LOS NEGATIVOS
2) ACTUALIZADO CON MI ULTIMA FUNCION
3) RESULTADOS COMPILANDO

"******TEST HECHO POR 79137913******"
**PRUEBA CON NUMEROS POSITIVOS HASTA EL MAX**
7913: 6,891 msec
BZro: 35,604 msec
E__C: 1,786 msec
Frog: 6,319 msec
Dark: 18,452 msec


Para ver el test: http://pastebin.com/LJm02bAw

GRACIAS POR LEER!!!
"Como no se puede igualar a Dios, ya he decidido que hacer, ¡SUPERARLO!"
"La peor de las ignorancias es no saber corregirlas"

79137913                          *Shadow Scouts Team*

tonomac3

Y yo que me iba a rendir. Ahora largo el celu y me pongo a programar

BlackZeroX

#15
Cita de: Mr. Frog © en 15 Febrero 2011, 13:48 PM

@BlackZer0xCreo que te equivocas, lo que hago es comprobar si el resultado es un número exacto o no, de esta manera :


Código (vb) [Seleccionar]


Option Explicit

Function isFibbonacci(ByVal vVal&) As Boolean
Dim dbl_v#(0 To 1)
Dim byt_i                   As Byte
    If Not vVal& And &H80000000 Then
        dbl_v#(1) = 1
        dbl_v#(0) = 0
        Do Until dbl_v#(byt_i) >= vVal&
            dbl_v#(byt_i) = dbl_v#(byt_i) + dbl_v#(byt_i Xor 1)
            byt_i = byt_i Xor 1
        Loop
        If dbl_v#(0) = vVal& Or dbl_v#(1) = vVal& Then
            isFibbonacci = True
        End If
    End If
End Function

Private Sub Form_Load()
Dim lng_i&
   For lng_i& = -214748 To 2
       If IsFibonacciMrFrog(lng_i&) = True Then
           Debug.Print lng_i&,
       End If
       If isFibbonacci(lng_i&) = True Then
           Debug.Print lng_i&
       End If
   Next lng_i&
End Sub

Public Static Function IsFibonacciMrFrog(ByVal lngNumber As Long) As Boolean
Dim dblRaised                                       As Double
Dim dblSum                                          As Double
Dim dblSqr                                          As Double

   dblRaised = lngNumber * lngNumber
   dblSum = dblRaised + dblRaised + dblRaised + dblRaised + dblRaised + &H4
   dblSqr = Sqr(dblSum)
   IsFibonacciMrFrog = (dblSqr - Int(dblSqr) = &H0)
   If IsFibonacciMrFrog Then Exit Function
   dblSum = dblSum - &H8
   dblSqr = Sqr(dblSum)
   IsFibonacciMrFrog = (dblSqr - Int(dblSqr) = &H0)
End Function



Creer no es bueno:
Usa clng() en lugar de int(), ( en vb6: int = 2 bytes, Double = 8 bytes, long = 4 bytes. ¿cual crees que abarca una cantidad mayor? )

los numeros superan a int().

Estos valores los calcule del 0 al 2147483647 (MAXIMO Numero en Long))



0
1
2
3
5
8
13
21
34
55
89
144
233
377
610
987
1597
2584
4181
6765
10946
17711
28657
46368
75025
121393
196418
317811
514229
832040
1346269
2178309
3524578
5702887
9227465
14930352
24157817
39088169
63245986
102334155
165580141
267914296
433494437
701408733
1134903170
1836311903



Dulces lunas!¡.
The Dark Shadow is my passion.

79137913

#16
HOLA!!!

Black tiene razon, no me habia dado cuenta :P

GRACIAS POR LEER!!!
"Como no se puede igualar a Dios, ya he decidido que hacer, ¡SUPERARLO!"
"La peor de las ignorancias es no saber corregirlas"

79137913                          *Shadow Scouts Team*

Psyke1

@Black
Oops... Lo peor de todo es que sé los bytes correspondientes a cada variable. :¬¬
No se porque pensaba que Int() era direfente de CInt() ... En fin, cosas mías, gracias por la corrección. ;)

DoEvents! :P

Elemental Code

#18
colgandome de lo que dijeron de cual era el limite se me ocurrio hacer trampa  :silbar:
Código (vb) [Seleccionar]
Public Function FibonacciChecker_eCode(ByRef lNumero As Long) As Boolean
Dim FiSplit() As String
Dim i As Long
Const Fi As String = "0,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181,6765,10946,17711,28657,46368"
FiSplit() = Split(Fi, ",", -1, vbBinaryCompare)

For i = 0 To 23
   If lNumero = CLng(FiSplit(i)) Then FibonacciChecker_eCode = True: Exit Function
   If lNumero < CLng(FiSplit(i)) Then FibonacciChecker_eCode = False: Exit Function
Next i
End Function


ahora reviso el codigo que no le tenia fe y resulto ser el mas rapido :P


Edito :D

Aca dejo optimizado el codigo que use antes, ahora reconoce el 0 y el 1
Código (vb) [Seleccionar]
Public Function IsFibonacci_eCode(ByRef lNumber As Long) As Boolean
Dim i As Long 'anterior
Dim y As Long 'actual
Dim x As Long 'Restultado a checkear
y = 1
   Do While x < lNumber
       If x = lNumber Then IsFibonacci_eCode = True: Exit Function
       x = i + y
       i = y
       y = x
   Loop
   IsFibonacci_eCode = False
End Function


Estoy maserando otro codigo, paciencia que ya voy ;)



Wiiiii :D

Gracias a MrFrog que me dijo que use el do-loop para armar esto :D
Código (vb) [Seleccionar]
Public Function IsFibonacci_eCodeMatrix(ByRef lNumero As Long) As Boolean
    Dim f() As Long
    Dim i As Long
    ReDim f(1)
    f(0) = 0
    f(1) = 1
    i = 2
    Do
        Debug.Print i; ","; f(i - 1)
        If lNumero = f(i - 1) Then IsFibonacci_eCode = True:  Exit Function
        If lNumero < f(i - 1) Then IsFibonacci_eCode = False:  Exit Function
        ReDim Preserve f(i)
        f(i) = f(i - 1) + f(i - 2)
        i = i + 1
    Loop
End Function


Tres codes para un reto. toy demasiado al pedo  :)



I CODE FOR $$$
Programo por $$$
Hago tareas, trabajos para la facultad, lo que sea en VB6.0

Mis programas

BlackZeroX

#19
.
Se vale hacer trampa? mmm, pues bueno aqui estan TODOS los numeros Fibonacci hasta el numero Máximo de Long.

Código (Vb) [Seleccionar]


Public Function IsFibonacci_WithCache(ByRef vVal As Long) As Boolean
Dim lng_i          As Long
Dim var_cache()
    var_cache() = Array(0, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, 2584, 4181, 6765, 10946, 17711, 28657, 46368, 75025, 121393, 196418, 317811, 514229, 832040, 1346269, 2178309, 3524578, 5702887, 9227465, 14930352, 24157817, 39088169, 63245986, 102334155, 165580141, 267914296, 433494437, 701408733, 1134903170, 1836311903)
    For lng_i = 0 To UBound(var_cache)
        If var_cache(lng_i) = vVal Then IsFibonacci_WithCache = True: Exit For
    Next lng_i
End Function



Temibles Lunas!¡.
The Dark Shadow is my passion.