Menu Close

Codificación de Fibonacci

La codificación de Fibonacci de un número n es una cadena d = d(0)d(1)…d(k-1)d(k) de ceros y unos tal que

   n = d(0)*F(2) + d(1)*F(3) +...+ d(k-1)*F(k+1) 
   d(k-1) = d(k) = 1

donde F(i) es el i-ésimo término de la sucesión de Fibonacci.

   0,1,1,2,3,5,8,13,21,34,...

Por ejemplo. La codificación de Fibonacci de 4 es “1011” ya que los dos últimos elementos son iguales a 1 y

   1*F(2) + 0*F(3) + 1*F(4) = 1*1 + 0*2 + 1*3 = 4

La codificación de Fibonacci de los primeros números se muestra en la siguiente tabla

    1  = 1     = F(2)           ≡       11
    2  = 2     = F(3)           ≡      011
    3  = 3     = F(4)           ≡     0011
    4  = 1+3   = F(2)+F(4)      ≡     1011
    5  = 5     = F(5)           ≡    00011
    6  = 1+5   = F(2)+F(5)      ≡    10011
    7  = 2+5   = F(3)+F(5)      ≡    01011
    8  = 8     = F(6)           ≡   000011
    9  = 1+8   = F(2)+F(6)      ≡   100011
   10  = 2+8   = F(3)+F(6)      ≡   010011
   11  = 3+8   = F(4)+F(6)      ≡   001011
   12  = 1+3+8 = F(2)+F(4)+F(6) ≡   101011
   13  = 13    = F(7)           ≡  0000011
   14  = 1+13  = F(2)+F(7)      ≡  1000011

Definir la función

   codigoFib :: Integer -> String

tal que (codigoFib n) es la codificación de Fibonacci del número n. Por ejemplo,

   λ> codigoFib 65
   "0100100011"
   λ> [codigoFib n | n <- [1..7]]
   ["11","011","0011","1011","00011","10011","01011"]

Soluciones

import Data.List
import Data.Array
import Test.QuickCheck
 
-- 1ª solución
-- ===========
 
codigoFib1 :: Integer -> String
codigoFib1 = (concatMap show) . codificaFibLista
 
-- (codificaFibLista n) es la lista correspondiente a la codificación de
-- Fibonacci del número n. Por ejemplo,
--    λ> codificaFibLista 65
--    [0,1,0,0,1,0,0,0,1,1]
--    λ> [codificaFibLista n | n <- [1..7]]
--    [[1,1],[0,1,1],[0,0,1,1],[1,0,1,1],[0,0,0,1,1],[1,0,0,1,1],[0,1,0,1,1]]
codificaFibLista :: Integer -> [Integer]
codificaFibLista n = map f [2..head xs] ++ [1]
  where xs = map fst (descomposicion n)
        f i | elem i xs = 1
            | otherwise = 0
 
-- (descomposicion n) es la lista de pares (i,f) tales que f es el
-- i-ésimo número de Fibonacci y las segundas componentes es una
-- sucesión decreciente de números de Fibonacci cuya suma es n. Por
-- ejemplo, 
--    descomposicion 65  ==  [(10,55),(6,8),(3,2)]
--    descomposicion 66  ==  [(10,55),(6,8),(4,3)]
descomposicion :: Integer -> [(Integer, Integer)]
descomposicion 0 = []
descomposicion 1 = [(2,1)]
descomposicion n = (i,x) : descomposicion (n-x)
  where (i,x) = fibAnterior n
 
-- (fibAnterior n) es el mayor número de Fibonacci menor o igual que
-- n. Por ejemplo,
--    fibAnterior 33  ==  (8,21)
--    fibAnterior 34  ==  (9,34)
fibAnterior :: Integer -> (Integer, Integer)
fibAnterior n = last (takeWhile p fibsConIndice)
  where p (i,x) = x <= n
 
-- fibsConIndice es la sucesión de los números de Fibonacci junto con
-- sus índices. Por ejemplo,
--    λ> take 10 fibsConIndice
--    [(0,0),(1,1),(2,1),(3,2),(4,3),(5,5),(6,8),(7,13),(8,21),(9,34)]
fibsConIndice :: [(Integer, Integer)]
fibsConIndice = zip [0..] fibs
 
-- fibs es la sucesión de Fibonacci. Por ejemplo, 
--    take 10 fibs  ==  [0,1,1,2,3,5,8,13,21,34]
fibs :: [Integer]
fibs = 0 : 1 : zipWith (+) fibs (tail fibs)
 
--- 2ª solución
-- ============
 
codigoFib2 :: Integer -> String
codigoFib2 = (concatMap show) . elems . codificaFibVec
 
-- (codificaFibVec n) es el vector correspondiente a la codificación de
-- Fibonacci del número n. Por ejemplo,
--    λ> codificaFibVec 65
--    array (0,9) [(0,0),(1,1),(2,0),(3,0),(4,1),(5,0),(6,0),(7,0),(8,1),(9,1)]
--    λ> [elems (codificaFibVec n) | n <- [1..7]]
--    [[1,1],[0,1,1],[0,0,1,1],[1,0,1,1],[0,0,0,1,1],[1,0,0,1,1],[0,1,0,1,1]]
codificaFibVec :: Integer -> Array Integer Integer
codificaFibVec n = accumArray (+) 0 (0,a+1) ((a+1,1):is) 
  where is = [(i-2,1) | (i,x) <- descomposicion n]
        a  = fst (head is)
 
-- Comparación de eficiencia
-- =========================
--    λ> head [n | n <- [1..], length (codigoFib1 n) > 25]
--    121393
--    (14.37 secs, 3135674112 bytes)
--    λ> :r
--    Ok, modules loaded: Main.
--    λ> head [n | n <- [1..], length (codigoFib2 n) > 25]
--    121393
--    (12.04 secs, 2762190920 bytes)
 
-- Propiedades
-- ===========
 
-- Usaremos la 2ª definición
codigoFib :: Integer -> String
codigoFib = codigoFib2
 
-- Prop.: La función descomposicion es correcta:
propDescomposicionCorrecta :: Integer -> Property
propDescomposicionCorrecta n =
  n >= 0 ==> n == sum (map snd (descomposicion n))
 
-- La comprobación es
--    λ> quickCheck propDescomposicionCorrecta
--    +++ OK, passed 100 tests.
 
-- Prop.: Todo número natural se puede descomponer en suma de números de
-- la sucesión de Fibonacci.
propDescomposicion :: Integer -> Property
propDescomposicion n =
  n >= 0 ==> not (null (descomposicion n))
 
-- La comprobación es
--    λ> quickCheck propDescomposicion
--    +++ OK, passed 100 tests.
 
-- Prop.: Las codificaciones de Fibonacci tienen como mínimo 2 elementos.
prop1 :: Integer -> Property
prop1 n = n > 0 ==> length (codigoFib n) >= 2
 
-- La comprobación es
--    λ> quickCheck prop1
--    +++ OK, passed 100 tests.
 
-- Prop.: Los dos últimos elementos de las codificaciones de Fibonacci
-- son iguales a 1.
prop2 :: Integer -> Property
prop2 n = n > 0 ==> take 2 (reverse (codigoFib n)) == "11"
 
-- La comprobación es
--    λ> quickCheck prop2
--    +++ OK, passed 100 tests.
 
-- Prop.: En las codificaciones de Fibonacci, la cadena "11" sólo
-- aparece una vez y la única vez que aparece es al final.
prop3 :: Integer -> Property
prop3 n = 
  n > 0 ==> not (isInfixOf "11" (drop 2 (reverse (codigoFib n))))
 
-- La comprobación es
--    λ> quickCheck prop3
--    +++ OK, passed 100 tests.

4 soluciones de “Codificación de Fibonacci

  1. fercarnav
    -- Problema hecho de manera normal y con búsqueda en espacios de estados.
     
    -- import I1M.BusquedaEnEspaciosDeEstados 
    -- import Data.List
     
    -- 1ª solución (con espacios de estados)
    -- =====================================
     
    inicial2 :: String
    inicial2 = "1"
     
    esFinal2 :: Integer -> String -> Bool
    esFinal2 n xs = sum (zipWith (*) (fib n) ys) == n
      where ys = [read [x] | x <- xs]
     
    esPosible :: Integer -> String -> Bool
    esPosible n xs = sum (zipWith (*) (fib n) ys) <= n 
      where ys = [read [x] | x<- xs]
     
    sucesores2 :: Integer -> String -> [String]
    sucesores2 n xs
      | esPosible n (xs++"1") = [xs ++ "1"]
      | otherwise             = [xs ++ "0"]
     
    fib :: Integer -> [Integer]
    fib n = reverse (takeWhile (<=n) fibonacci) 
     
    fibonacci :: [Integer]
    fibonacci = 1 : 1: zipWith (+) fibonacci (tail fibonacci)
     
    codigoFib :: Integer -> String
    codigoFib n =
      reverse ("1" ++ head (buscaEE (sucesores2 n) (esFinal2 n) inicial2) ++
              (replicate (x-v-1) '0'))
      where x = genericLength (fib n)
            v = genericLength (head (buscaEE (sucesores2 n) (esFinal2 n) inicial2))
     
    -- 2ª solución (sin espacios de estados)
    -- =====================================
     
    codigoFib2 :: Integer -> String
    codigoFib2 n = reverse ("1" ++(codi n "1") ++ (replicate (x-v-1) '0'))
      where x = genericLength (fib n)
            v = genericLength (codi n "1")
     
    codi :: Integer -> String -> String
    codi n xs
      | esFinal2 n xs = xs
      | otherwise     = codi n (sucesores1 n xs)
     
    sucesores1 :: Integer -> String -> String
    sucesores1 n xs
      | esPosible n (xs++"1") = (xs ++" 1")
      | otherwise =             (xs ++" 0")
  2. melgonaco
    import Data.List
     
    codigoFib :: Integer -> String
    codigoFib n = aux (reverse (posFib n)) [2..]
      where aux [] _ = "1"
            aux (x:xs) (y:ys) | x == y    = "1" ++ aux xs ys
                              | otherwise = "0" ++ aux (x:xs) ys
     
    fibonaccis :: [Integer]
    fibonaccis = 0 : 1 : zipWith (+) fibonaccis (tail fibonaccis)
     
    posFib :: Integer -> [Integer]
    posFib n | n == last xs = [genericLength xs - 1]
             | otherwise    = genericLength xs - 1 : posFib (n-last xs)
      where xs = takeWhile (<=n) fibonaccis
  3. juasuator1
    codigoFib n = codigoFibSin11 n  ++ "11"
    codigoFibSin11  =   numeroEnFi. posicionesEnFi . descomponEnNdeFi  
    numeroEnFi (x:xs) = aux  (nDeFienFinarioSin11 x) 1 xs
      where aux (y:ys) n xs | n `elem` xs = '1': aux ys (n+1) xs
                            | otherwise = y: aux ys (n+1) xs 
            aux ""  n xs = ""
     
     
    nDeFienFinarioSin11 n  = replicate ((length q) -3) '0' 
      where  q = (takeWhile (<= n ) fib)
     
     
    posicionesEnFi (x:xs) = [x] ++ map f xs
      where f 1 = 1 
            f a  = head [ c | (b,c) <- zip fib [1..] , a == b ] - 2
     
    descomponEnNdeFi 0 = []  
    descomponEnNdeFi n =  q : descomponEnNdeFi t
      where  q = last  (takeWhile (<= n ) fib)
             t = n - q
     
     
    fib = 0: aux1 1 1
      where aux1 a b = a : aux1 b (a+b)
  4. Enrique Zubiría
    fibonacci :: [Integer]
    fibonacci = 0:1:zipWith (+) fibonacci (tail fibonacci)
     
    codigoFib :: Integer -> String
    codigoFib n = [ if elem y (codigoFib' n) then '1' else '0' | y <- fibs] ++ ['1']
      where fibs = drop 2 (takeWhile (<= n) fibonacci)
            codigoFib' n
              | n-a /= 0  = codigoFib' (n-a) ++ [a]
              | otherwise = [a]
              where (a, b) = last $ (zip (fibsN) [2..])
                    fibsN  = (takeWhile (<= n) fibs)

Leave a Reply

Este sitio usa Akismet para reducir el spam. Aprende cómo se procesan los datos de tus comentarios.