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. |
José A. Alonso