PFH: La semana en Exercitium (del 25 al 30 de abril)
Esta semana he publicado en Exercitium las soluciones de los siguientes problemas:
- 1. Representación de Zeckendorf
- 2. Producto cartesiano de una familia de conjuntos
- 3. Números con todos sus dígitos primos
A continuación se muestran las soluciones.
1. Representación de Zeckendorf
Los primeros números de Fibonacci son
1 |
1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, ... |
tales que los dos primeros son iguales a 1 y los siguientes se obtienen sumando los dos anteriores.
El teorema de Zeckendorf establece que todo entero positivo n se puede representar, de manera única, como la suma de números de Fibonacci no consecutivos decrecientes. Dicha suma se llama la representación de Zeckendorf de n. Por ejemplo, la representación de Zeckendorf de 100 es
1 |
100 = 89 + 8 + 3 |
Hay otras formas de representar 100 como sumas de números de Fibonacci; por ejemplo,
1 2 |
100 = 89 + 8 + 2 + 1 100 = 55 + 34 + 8 + 3 |
pero no son representaciones de Zeckendorf porque 1 y 2 son números de Fibonacci consecutivos, al igual que 34 y 55.
Definir la función
1 |
zeckendorf :: Integer -> [Integer] |
tal que (zeckendorf n)
es la representación de Zeckendorf de n
. Por ejemplo,
1 2 3 4 |
zeckendorf 100 == [89,8,3] zeckendorf 200 == [144,55,1] zeckendorf 300 == [233,55,8,3,1] length (zeckendorf (10^50000)) == 66097 |
Soluciones
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 |
module Representacion_de_Zeckendorf where import Data.List (subsequences) import Test.QuickCheck -- 1ª solución -- =========== zeckendorf1 :: Integer -> [Integer] zeckendorf1 = head . zeckendorf1Aux zeckendorf1Aux :: Integer -> [[Integer]] zeckendorf1Aux n = [xs | xs <- subsequences (reverse (takeWhile (<= n) (tail fibs))), sum xs == n, sinFibonacciConsecutivos xs] -- fibs es la la sucesión de los números de Fibonacci. Por ejemplo, -- take 14 fibs == [1,1,2,3,5,8,13,21,34,55,89,144,233,377] fibs :: [Integer] fibs = 1 : scanl (+) 1 fibs -- (sinFibonacciConsecutivos xs) se verifica si en la sucesión -- decreciente de número de Fibonacci xs no hay dos consecutivos. Por -- ejemplo, -- (sinFibonacciConsecutivos xs) se verifica si en la sucesión -- decreciente de número de Fibonacci xs no hay dos consecutivos. Por -- ejemplo, -- sinFibonacciConsecutivos [89, 8, 3] == True -- sinFibonacciConsecutivos [55, 34, 8, 3] == False sinFibonacciConsecutivos :: [Integer] -> Bool sinFibonacciConsecutivos xs = and [x /= siguienteFibonacci y | (x,y) <- zip xs (tail xs)] -- (siguienteFibonacci n) es el menor número de Fibonacci mayor que -- n. Por ejemplo, -- siguienteFibonacci 34 == 55 siguienteFibonacci :: Integer -> Integer siguienteFibonacci n = head (dropWhile (<= n) fibs) -- 2ª solución -- =========== zeckendorf2 :: Integer -> [Integer] zeckendorf2 = head . zeckendorf2Aux zeckendorf2Aux :: Integer -> [[Integer]] zeckendorf2Aux n = map reverse (aux n (tail fibs)) where aux 0 _ = [[]] aux m (x:y:zs) | x <= m = [x:xs | xs <- aux (m-x) zs] ++ aux m (y:zs) | otherwise = [] -- 3ª solución -- =========== zeckendorf3 :: Integer -> [Integer] zeckendorf3 0 = [] zeckendorf3 n = x : zeckendorf3 (n - x) where x = last (takeWhile (<= n) fibs) -- 4ª solución -- =========== zeckendorf4 :: Integer -> [Integer] zeckendorf4 n = aux n (reverse (takeWhile (<= n) fibs)) where aux 0 _ = [] aux m (x:xs) = x : aux (m-x) (dropWhile (>m-x) xs) -- Comprobación de equivalencia -- ============================ -- La propiedad es prop_zeckendorf :: Positive Integer -> Bool prop_zeckendorf (Positive n) = all (== zeckendorf1 n) [zeckendorf2 n, zeckendorf3 n, zeckendorf4 n] -- La comprobación es -- λ> quickCheck prop_zeckendorf -- +++ OK, passed 100 tests. -- Comparación de eficiencia -- ========================= -- La comparación es -- λ> zeckendorf1 (7*10^4) -- [46368,17711,4181,1597,89,34,13,5,2] -- (1.49 secs, 2,380,707,744 bytes) -- λ> zeckendorf2 (7*10^4) -- [46368,17711,4181,1597,89,34,13,5,2] -- (0.07 secs, 21,532,008 bytes) -- -- λ> zeckendorf2 (10^6) -- [832040,121393,46368,144,55] -- (1.40 secs, 762,413,432 bytes) -- λ> zeckendorf3 (10^6) -- [832040,121393,46368,144,55] -- (0.01 secs, 542,488 bytes) -- λ> zeckendorf4 (10^6) -- [832040,121393,46368,144,55] -- (0.01 secs, 536,424 bytes) -- -- λ> length (zeckendorf3 (10^3000)) -- 3947 -- (3.02 secs, 1,611,966,408 bytes) -- λ> length (zeckendorf4 (10^2000)) -- 2611 -- (0.02 secs, 10,434,336 bytes) -- -- λ> length (zeckendorf4 (10^50000)) -- 66097 -- (2.84 secs, 3,976,483,760 bytes) |
El código se encuentra en GitHub.
La elaboración de las soluciones se describe en el siguiente vídeo
2. Producto cartesiano de una familia de conjuntos
Definir la función
1 |
producto :: [[a]] -> [[a]] |
tal que (producto xss) es el producto cartesiano de los conjuntos xss. Por ejemplo,
1 2 3 4 5 6 7 8 |
λ> producto [[1,3],[2,5]] [[1,2],[1,5],[3,2],[3,5]] λ> producto [[1,3],[2,5],[6,4]] [[1,2,6],[1,2,4],[1,5,6],[1,5,4],[3,2,6],[3,2,4],[3,5,6],[3,5,4]] λ> producto [[1,3,5],[2,4]] [[1,2],[1,4],[3,2],[3,4],[5,2],[5,4]] λ> producto [] [[]] |
Comprobar con QuickCheck que para toda lista de listas de números enteros, xss, se verifica que el número de elementos de (producto xss) es igual al producto de los números de elementos de cada una de las listas de xss.
Soluciones
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 |
module Producto_cartesiano where import Test.QuickCheck (quickCheck) import Control.Monad (liftM2) import Control.Applicative (liftA2) -- 1ª solución -- =========== producto1 :: [[a]] -> [[a]] producto1 [] = [[]] producto1 (xs:xss) = [x:ys | x <- xs, ys <- producto1 xss] -- 2ª solución -- =========== producto2 :: [[a]] -> [[a]] producto2 [] = [[]] producto2 (xs:xss) = [x:ys | x <- xs, ys <- ps] where ps = producto2 xss -- 3ª solución -- =========== producto3 :: [[a]] -> [[a]] producto3 [] = [[]] producto3 (xs:xss) = inserta3 xs (producto3 xss) -- (inserta xs xss) inserta cada elemento de xs en los elementos de -- xss. Por ejemplo, -- λ> inserta [1,2] [[3,4],[5,6]] -- [[1,3,4],[1,5,6],[2,3,4],[2,5,6]] inserta3 :: [a] -> [[a]] -> [[a]] inserta3 [] _ = [] inserta3 (x:xs) yss = [x:ys | ys <- yss] ++ inserta3 xs yss -- 4ª solución -- =========== producto4 :: [[a]] -> [[a]] producto4 = foldr inserta4 [[]] inserta4 :: [a] -> [[a]] -> [[a]] inserta4 [] _ = [] inserta4 (x:xs) yss = map (x:) yss ++ inserta4 xs yss -- 5ª solución -- =========== producto5 :: [[a]] -> [[a]] producto5 = foldr inserta5 [[]] inserta5 :: [a] -> [[a]] -> [[a]] inserta5 xs yss = [x:ys | x <- xs, ys <- yss] -- 6ª solución -- =========== producto6 :: [[a]] -> [[a]] producto6 = foldr inserta6 [[]] inserta6 :: [a] -> [[a]] -> [[a]] inserta6 xs yss = concatMap (\x -> map (x:) yss) xs -- 7ª solución -- =========== producto7 :: [[a]] -> [[a]] producto7 = foldr inserta7 [[]] inserta7 :: [a] -> [[a]] -> [[a]] inserta7 xs yss = xs >>= (\x -> map (x:) yss) -- 8ª solución -- =========== producto8 :: [[a]] -> [[a]] producto8 = foldr inserta8 [[]] inserta8 :: [a] -> [[a]] -> [[a]] inserta8 xs yss = (:) <$> xs <*> yss -- 9ª solución -- =========== producto9 :: [[a]] -> [[a]] producto9 = foldr inserta9 [[]] inserta9 :: [a] -> [[a]] -> [[a]] inserta9 = liftA2 (:) -- 10ª solución -- ============ producto10 :: [[a]] -> [[a]] producto10 = foldr (liftM2 (:)) [[]] -- 11ª solución -- ============ producto11 :: [[a]] -> [[a]] producto11 = sequence -- Comprobación de equivalencia -- ============================ -- La propiedad es prop_producto :: [[Int]] -> Bool prop_producto xss = all (== producto1 xss) [ producto2 xss , producto3 xss , producto4 xss , producto5 xss , producto6 xss , producto7 xss , producto8 xss , producto9 xss , producto10 xss , producto11 xss ] -- La comprobación es -- λ> quickCheckWith (stdArgs {maxSize = 9}) prop_producto -- +++ OK, passed 100 tests. -- Comparación de eficiencia -- ========================= -- La comparación es -- λ> length (producto1 (replicate 7 [0..9])) -- 10000000 -- (10.51 secs, 10,169,418,496 bytes) -- λ> length (producto2 (replicate 7 [0..9])) -- 10000000 -- (2.14 secs, 1,333,870,712 bytes) -- λ> length (producto3 (replicate 7 [0..9])) -- 10000000 -- (3.33 secs, 1,956,102,056 bytes) -- λ> length (producto4 (replicate 7 [0..9])) -- 10000000 -- (0.98 secs, 1,600,542,752 bytes) -- λ> length (producto5 (replicate 7 [0..9])) -- 10000000 -- (2.10 secs, 1,333,870,288 bytes) -- λ> length (producto6 (replicate 7 [0..9])) -- 10000000 -- (1.17 secs, 1,600,534,632 bytes) -- λ> length (producto7 (replicate 7 [0..9])) -- 10000000 -- (0.35 secs, 1,600,534,352 bytes) -- λ> length (producto8 (replicate 7 [0..9])) -- 10000000 -- (0.87 secs, 978,317,848 bytes) -- λ> length (producto9 (replicate 7 [0..9])) -- 10000000 -- (1.38 secs, 1,067,201,016 bytes) -- λ> length (producto10 (replicate 7 [0..9])) -- 10000000 -- (0.54 secs, 2,311,645,392 bytes) -- λ> length (producto11 (replicate 7 [0..9])) -- 10000000 -- (1.32 secs, 1,067,200,992 bytes) -- -- λ> length (producto7 (replicate 7 [1..14])) -- 105413504 -- (3.77 secs, 16,347,739,040 bytes) -- λ> length (producto10 (replicate 7 [1..14])) -- 105413504 -- (5.11 secs, 23,613,162,016 bytes) -- Comprobación de la propiedad -- ============================ -- La propiedad es prop_longitud :: [[Int]] -> Bool prop_longitud xss = length (producto7 xss) == product (map length xss) -- La comprobación es -- λ> quickCheckWith (stdArgs {maxSize = 7}) prop_longitud -- +++ OK, passed 100 tests. |
El código se encuentra en GitHub.
La elaboración de las soluciones se describe en el siguiente vídeo
3. Números con todos sus dígitos primos
Definir la lista
1 |
numerosConDigitosPrimos :: [Integer] |
cuyos elementos son los números con todos sus dígitos primos. Por ejemplo,
1 2 3 4 |
λ> take 22 numerosConDigitosPrimos [2,3,5,7,22,23,25,27,32,33,35,37,52,53,55,57,72,73,75,77,222,223] λ> numerosConDigitosPrimos !! (10^7) 322732232572 |
Soluciones
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 |
module Numeros_con_digitos_primos where import Test.QuickCheck (NonNegative (NonNegative), quickCheck) import Data.Char (intToDigit) -- 1ª solución -- =========== numerosConDigitosPrimos1 :: [Integer] numerosConDigitosPrimos1 = [n | n <- [2..], digitosPrimos n] -- (digitosPrimos n) se verifica si todos los dígitos de n son -- primos. Por ejemplo, -- digitosPrimos 352 == True -- digitosPrimos 362 == False digitosPrimos :: Integer -> Bool digitosPrimos n = subconjunto (digitos n) [2,3,5,7] -- (digitos n) es la lista de las digitos de n. Por ejemplo, -- digitos 325 == [3,2,5] digitos :: Integer -> [Integer] digitos n = [read [x] | x <- show n] -- (subconjunto xs ys) se verifica si xs es un subconjunto de ys. Por -- ejemplo, -- subconjunto [3,2,5,2] [2,7,3,5] == True -- subconjunto [3,2,5,2] [2,7,2,5] == False subconjunto :: Eq a => [a] -> [a] -> Bool subconjunto xs ys = and [x `elem` ys | x <- xs] -- 2ª solución -- =========== numerosConDigitosPrimos2 :: [Integer] numerosConDigitosPrimos2 = filter (all (`elem` "2357") . show) [2..] -- 3ª solución -- =========== -- λ> take 60 numerosConDigitosPrimos2 -- [ 2, 3, 5, 7, -- 22, 23, 25, 27, -- 32, 33, 35, 37, -- 52, 53, 55, 57, -- 72, 73, 75, 77, -- 222,223,225,227, -- 232,233,235,237, -- 252,253,255,257, -- 272,273,275,277, -- 322,323,325,327, -- 332,333,335,337, -- 352,353,355,357, -- 372,373,375,377, -- 522,523,525,527, -- 532,533,535,537] numerosConDigitosPrimos3 :: [Integer] numerosConDigitosPrimos3 = [2,3,5,7] ++ [10*n+d | n <- numerosConDigitosPrimos3, d <- [2,3,5,7]] -- 4ª solución -- =========== -- λ> take 60 numerosConDigitosPrimos2 -- [ 2, 3, 5, 7, -- 22,23,25,27, -- 32,33,35,37, -- 52,53,55,57, -- 72,73,75,77, -- 222,223,225,227, 232,233,235,237, 252,253,255,257, 272,273,275,277, -- 322,323,325,327, 332,333,335,337, 352,353,355,357, 372,373,375,377, -- 522,523,525,527, 532,533,535,537] numerosConDigitosPrimos4 :: [Integer] numerosConDigitosPrimos4 = concat (iterate siguiente [2,3,5,7]) -- (siguiente xs) es la lista obtenida añadiendo delante de cada -- elemento de xs los dígitos 2, 3, 5 y 7. Por ejemplo, -- λ> siguiente [5,6,8] -- [25,26,28, -- 35,36,38, -- 55,56,58, -- 75,76,78] siguiente :: [Integer] -> [Integer] siguiente xs = concat [map (pega d) xs | d <- [2,3,5,7]] -- (pega d n) es el número obtenido añadiendo el dígito d delante del -- número n. Por ejemplo, -- pega 3 35 == 335 pega :: Int -> Integer -> Integer pega d n = read (intToDigit d : show n) -- Comprobación de equivalencia -- ============================ -- La propiedad es prop_numerosConDigitosPrimos :: NonNegative Int -> Bool prop_numerosConDigitosPrimos (NonNegative n) = all (== numerosConDigitosPrimos1 !! n) [ numerosConDigitosPrimos2 !! n , numerosConDigitosPrimos3 !! n , numerosConDigitosPrimos4 !! n ] -- La comprobación es -- λ> quickCheck prop_numerosConDigitosPrimos -- +++ OK, passed 100 tests. -- Comparación de eficiencia -- ========================= -- La comparación es -- λ> numerosConDigitosPrimos1 !! 5000 -- 752732 -- (2.45 secs, 6,066,926,272 bytes) -- λ> numerosConDigitosPrimos2 !! 5000 -- 752732 -- (0.34 secs, 387,603,456 bytes) -- λ> numerosConDigitosPrimos3 !! 5000 -- 752732 -- (0.01 secs, 1,437,624 bytes) -- λ> numerosConDigitosPrimos4 !! 5000 -- 752732 -- (0.00 secs, 1,556,104 bytes) -- -- λ> numerosConDigitosPrimos3 !! (10^7) -- 322732232572 -- (3.94 secs, 1,820,533,328 bytes) -- λ> numerosConDigitosPrimos4 !! (10^7) -- 322732232572 -- (1.84 secs, 2,000,606,640 bytes) |
El código se encuentra en GitHub.
La elaboración de las soluciones se describe en el siguiente vídeo