Esta semana he publicado en Exercitium las soluciones de los siguientes problemas:
- 1. La sucesión del reloj astronómico de Praga
- 2. Codificación de Fibonacci
- 3. Pandigitales primos
- 4. Aproximación del número pi
- 5. Números autodescriptivos
A continuación se muestran las soluciones.
1. La sucesión del reloj astronómico de Praga
La cadena infinita “1234321234321234321…”, formada por la repetición de los dígitos 123432, tiene una propiedad (en la que se basa el funcionamiento del reloj astronómico de Praga: la cadena se puede partir en una sucesión de números, de forma que la suma de los dígitos de dichos números es la sucesión de los números naturales, como se observa a continuación:
1, 2, 3, 4, 32, 123, 43, 2123, 432, 1234, 32123, ...
1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, ... |
Definir la lista
reloj :: [Integer] |
cuyos elementos son los términos de la sucesión anterior. Por ejemplo,
λ> take 11 reloj [1,2,3,4,32,123,43,2123,432,1234,32123] λ> (reloj !! 1000) `mod` (10^50) 23432123432123432123432123432123432123432123432123 |
Soluciones
import Data.List (inits, tails) import Data.Char (digitToInt) import Test.QuickCheck (NonNegative (NonNegative), quickCheck) -- 1ª solución -- =========== reloj1 :: [Integer] reloj1 = aux [1..] (cycle "123432") where aux (n:ns) xs = read ys : aux ns zs where (ys,zs) = prefijoSuma n xs -- (prefijoSuma n xs) es el par formado por el primer prefijo de xs cuyo -- suma es n y el resto de xs. Por ejemplo, -- prefijoSuma 6 "12343" == ("123","43") prefijoSuma :: Int -> String -> (String,String) prefijoSuma n xs = head [(us,vs) | (us,vs) <- zip (inits xs) (tails xs) , sumaD us == n] -- (sumaD xs) es la suma de los dígitos de xs. Por ejemplo, -- sumaD "123" == 6 sumaD :: String -> Int sumaD = sum . map digitToInt -- 2ª solución -- =========== reloj2 :: [Integer] reloj2 = aux [1..] (cycle "123432") where aux (n:ns) xs = read ys : aux ns zs where (ys,zs) = prefijoSuma2 n xs -- (prefijoSuma n xs) es el par formado por el primer prefijo de xs cuyo -- suma es n y el resto de xs. Por ejemplo, -- prefijoSuma2 6 "12343" == ("123","43") prefijoSuma2 :: Int -> String -> (String,String) prefijoSuma2 n (x:xs) | y == n = ([x],xs) | otherwise = (x:ys,zs) where y = read [x] (ys,zs) = prefijoSuma2 (n-y) xs -- Comprobación de equivalencia -- ============================ -- La propiedad es prop_reloj :: NonNegative Int -> Bool prop_reloj (NonNegative n) = reloj1 !! n == reloj2 !! n -- La comprobación es -- λ> quickCheck prop_reloj -- +++ OK, passed 100 tests. -- Comparación de eficiencia -- ========================= -- La comparación es -- λ> (reloj1 !! 1000) `mod` (10^9) -- 123432123 -- (2.47 secs, 5,797,620,784 bytes) -- λ> (reloj2 !! 1000) `mod` (10^9) -- 123432123 -- (0.44 secs, 798,841,528 bytes) |
El código se encuentra en GitHub.
2. Codificación de Fibonacci
La codificación de Fibonacci http://bit.ly/1Lllqjv 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"] |
Comprobar con QuickCheck las siguientes propiedades:
- Todo entero positivo se puede descomponer en suma de números de la sucesión de Fibonacci.
- Las codificaciones de Fibonacci tienen como mínimo 2 elementos.
- En las codificaciones de Fibonacci, la cadena “11” sólo aparece una vez y la única vez que aparece es al final.
Soluciones
import Data.List (isInfixOf) import Data.Array (Array, accumArray, elems) import Test.QuickCheck (Positive (Positive), 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 | i `elem` 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 (_,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,_) <- descomposicion n] a = fst (head is) -- Comprobación de equivalencia -- ============================ -- La propiedad es prop_codigoFib :: Positive Integer -> Bool prop_codigoFib (Positive n) = codigoFib1 n == codigoFib2 n -- La comprobación es -- λ> quickCheck prop_codigoFib -- +++ OK, passed 100 tests. -- Comparación de eficiencia -- ========================= -- La comparación es -- λ> head [n | n <- [1..], length (codigoFib1 n) > 25] -- 121393 -- (4.30 secs, 3,031,108,104 bytes) -- λ> head [n | n <- [1..], length (codigoFib2 n) > 25] -- 121393 -- (3.46 secs, 2,505,869,616 bytes) -- Propiedades -- =========== -- Usaremos la 2ª definición codigoFib :: Integer -> String codigoFib = codigoFib2 -- Prop.: La función descomposicion es correcta: prop_descomposicion_correcta :: Positive Integer -> Bool prop_descomposicion_correcta (Positive n) = n == sum (map snd (descomposicion n)) -- La comprobación es -- λ> quickCheck prop_descomposicion_correcta -- +++ OK, passed 100 tests. -- Prop.: Todo entero positivo se puede descomponer en suma de números de -- la sucesión de Fibonacci. prop_descomposicion :: Positive Integer -> Bool prop_descomposicion (Positive n) = not (null (descomposicion n)) -- La comprobación es -- λ> quickCheck prop_descomposicion -- +++ OK, passed 100 tests. -- Prop.: Las codificaciones de Fibonacci tienen como mínimo 2 elementos. prop_length_codigoFib :: Positive Integer -> Bool prop_length_codigoFib (Positive n) = length (codigoFib n) >= 2 -- La comprobación es -- λ> quickCheck prop_length_codigoFib -- +++ 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_cadena_11_en_codigoFib :: Positive Integer -> Bool prop3_cadena_11_en_codigoFib (Positive n) = take 2 xs == "11" && not ("11" `isInfixOf` drop 2 xs) where xs = reverse (codigoFib n) -- La comprobación es -- λ> quickCheck prop3_cadena_11_en_codigoFib -- +++ OK, passed 100 tests. |
El código se encuentra en GitHub.
3. Pandigitales primos
Un número con n dígitos es pandigital si contiene todos los dígitos del 1 a n exactamente una vez. Por ejemplo, 2143 es un pandigital con 4 dígitos y, además, es primo.
Definir la lista
pandigitalesPrimos :: [Int] |
tal que sus elementos son los números pandigitales primos, ordenados de mayor a menor. Por ejemplo,
take 3 pandigitalesPrimos == [7652413,7642513,7641253] 2143 `elem` pandigitalesPrimos == True length pandigitalesPrimos == 538 |
Soluciones
import Data.List (permutations, sort) import Data.Char (intToDigit) import Data.Numbers.Primes (isPrime) -- 1ª solución -- =========== pandigitalesPrimos1 :: [Int] pandigitalesPrimos1 = concatMap nPandigitalesPrimos1 [9,8..1] -- (nPandigitalesPrimos n) es la lista de los números pandigitales con n -- dígitos, ordenada de mayor a menor. Por ejemplo, -- nPandigitalesPrimos 4 == [4231,2341,2143,1423] -- nPandigitalesPrimos 5 == [] nPandigitalesPrimos1 :: Int -> [Int] nPandigitalesPrimos1 n = filter isPrime (pandigitales n) -- (pandigitales n) es la lista de los números pandigitales de n dígitos -- ordenada de mayor a menor. Por ejemplo, -- pandigitales 3 == [321,312,231,213,132,123] pandigitales :: Int -> [Int] pandigitales n = reverse $ sort $ map digitosAentero (permutations [1..n]) -- (digitosAentero ns) es el número cuyos dígitos son ns. Por ejemplo, -- digitosAentero [3,2,5] == 325 digitosAentero :: [Int] -> Int digitosAentero = read . map intToDigit -- 2ª solución -- =========== pandigitalesPrimos2 :: [Int] pandigitalesPrimos2 = concatMap nPandigitalesPrimos2 [9,8..1] -- Nota. La definición de nPandigitalesPrimos1 se puede simplificar, ya -- que la suma de los números de 1 a n es divisible por 3, entonces los -- números pandigitales con n dígitos también lo son y, por tanto, no -- son primos. nPandigitalesPrimos2 :: Int -> [Int] nPandigitalesPrimos2 n | sum [1..n] `mod` 3 == 0 = [] | otherwise = filter isPrime (pandigitales n) -- 2ª solución -- =========== pandigitalesPrimos3 :: [Int] pandigitalesPrimos3 = concatMap nPandigitalesPrimos3 [9,8..1] -- La definición de nPandigitales se puede simplificar, ya que -- λ> [n | n <- [1..9], sum [1..n] `mod` 3 /= 0] -- [1,4,7] nPandigitalesPrimos3 :: Int -> [Int] nPandigitalesPrimos3 n | n `elem` [4,7] = filter isPrime (pandigitales n) | otherwise = [] -- Comprobación de equivalencia -- ============================ -- La propiedad es prop_pandigitalesPrimos :: Bool prop_pandigitalesPrimos = all (== pandigitalesPrimos1) [pandigitalesPrimos2, pandigitalesPrimos3] -- La comprobación es -- λ> prop_pandigitalesPrimos -- True -- Comparación de eficiencia -- ========================= -- La comparación es -- λ> length (pandigitalesPrimos1) -- 538 -- (1.44 secs, 5,249,850,032 bytes) -- λ> length (pandigitalesPrimos2) -- 538 -- (0.14 secs, 619,249,632 bytes) -- λ> length (pandigitalesPrimos3) -- 538 -- (0.14 secs, 619,237,464 bytes) |
El código se encuentra en GitHub.
4. Aproximación del número pi
Una forma de aproximar el número π es usando la siguiente igualdad:
π 1 1·2 1·2·3 1·2·3·4
--- = 1 + --- + ----- + ------- + --------- + ....
2 3 3·5 3·5·7 3·5·7·9 |
Es decir, la serie cuyo término general n-ésimo es el cociente entre el producto de los primeros n números y los primeros n números impares:
Π i
s(n) = -----------
Π (2*i+1) |
Definir la función
aproximaPi :: Integer -> Double |
tal que (aproximaPi n) es la aproximación del número π calculada con la serie anterior hasta el término n-ésimo. Por ejemplo,
aproximaPi 10 == 3.1411060206 aproximaPi 20 == 3.1415922987403397 aproximaPi 30 == 3.1415926533011596 aproximaPi 40 == 3.1415926535895466 aproximaPi 50 == 3.141592653589793 aproximaPi (10^4) == 3.141592653589793 pi == 3.141592653589793 |
Soluciones
import Data.Ratio ((%)) import Data.List (genericTake) import Test.QuickCheck (Property, arbitrary, forAll, suchThat, quickCheck) -- 1ª solución -- =========== aproximaPi1 :: Integer -> Double aproximaPi1 n = fromRational (2 * sum [product [1..i] % product [1,3..2*i+1] | i <- [0..n]]) -- 2ª solución -- =========== aproximaPi2 :: Integer -> Double aproximaPi2 0 = 2 aproximaPi2 n = aproximaPi2 (n-1) + fromRational (2 * product [1..n] % product [3,5..2*n+1]) -- 3ª solución -- =========== aproximaPi3 :: Integer -> Double aproximaPi3 n = fromRational (2 * (1 + sum (zipWith (%) numeradores (genericTake n denominadores)))) -- numeradores es la sucesión de los numeradores. Por ejemplo, -- λ> take 10 numeradores -- [1,2,6,24,120,720,5040,40320,362880,3628800] numeradores :: [Integer] numeradores = scanl (*) 1 [2..] -- denominadores es la sucesión de los denominadores. Por ejemplo, -- λ> take 10 denominadores -- [3,15,105,945,10395,135135,2027025,34459425,654729075,13749310575] denominadores :: [Integer] denominadores = scanl (*) 3 [5, 7..] -- 4ª solución -- =========== aproximaPi4 :: Integer -> Double aproximaPi4 n = read (x : "." ++ xs) where (x:xs) = show (aproximaPi4' n) aproximaPi4' :: Integer -> Integer aproximaPi4' n = 2 * (p + sum (zipWith div (map (*p) numeradores) (genericTake n denominadores))) where p = 10^n -- Comprobación de equivalencia -- ============================ -- La propiedad es prop_aproximaPi :: Property prop_aproximaPi = forAll (arbitrary `suchThat` (> 3)) $ \n -> all (=~ aproximaPi1 n) [aproximaPi2 n, aproximaPi3 n, aproximaPi4 n] (=~) :: Double -> Double -> Bool x =~ y = abs (x - y) < 0.001 -- La comprobación es -- λ> quickCheck prop_aproximaPi -- +++ OK, passed 100 tests. -- Comparación de eficiencia -- ========================= -- La comparación es -- λ> aproximaPi1 3000 -- 3.141592653589793 -- (4.96 secs, 27,681,824,408 bytes) -- λ> aproximaPi2 3000 -- 3.1415926535897922 -- (3.00 secs, 20,496,194,496 bytes) -- λ> aproximaPi3 3000 -- 3.141592653589793 -- (3.13 secs, 13,439,528,432 bytes) -- λ> aproximaPi4 3000 -- 3.141592653589793 -- (0.09 secs, 23,142,144 bytes) |
El código se encuentra en GitHub.
5. Números autodescriptivos
Un número n es autodescriptivo cuando para cada posición k de n (empezando a contar las posiciones a partir de 0), el dígito en la posición k es igual al número de veces que ocurre k en n. Por ejemplo, 1210 es autodescriptivo porque tiene 1 dígito igual a “0”, 2 dígitos iguales a “1”, 1 dígito igual a “2” y ningún dígito igual a “3”.
Definir la función
autodescriptivo :: Integer -> Bool |
tal que (autodescriptivo n) se verifica si n es autodescriptivo. Por ejemplo,
λ> autodescriptivo 1210 True λ> [x | x <- [1..100000], autodescriptivo x] [1210,2020,21200] λ> autodescriptivo 9210000001000 True |
Soluciones
import Data.Char (digitToInt) import Data.List (genericLength) import Test.QuickCheck -- 1ª solución -- =========== autodescriptivo1 :: Integer -> Bool autodescriptivo1 n = autodescriptiva (digitos n) -- (digitos n) es la lista de los dígitos de n. Por ejemplo. -- digitos 325 == [3,2,5] digitos :: Integer -> [Integer] digitos n = [read [d] | d <- show n] -- (autodescriptiva ns) se verifica si la lista de dígitos ns es -- autodescriptiva; es decir, si para cada posición k de ns -- (empezando a contar las posiciones a partir de 0), el dígito en la -- posición k es igual al número de veces que ocurre k en ns. Por -- ejemplo, -- autodescriptiva [1,2,1,0] == True -- autodescriptiva [1,2,1,1] == False autodescriptiva :: [Integer] -> Bool autodescriptiva ns = and [x == ocurrencias k ns | (k,x) <- zip [0..] ns] -- (ocurrencias x ys) es el número de veces que ocurre x en ys. Por -- ejemplo, -- ocurrencias 1 [1,2,1,0,1] == 3 ocurrencias :: Integer -> [Integer] -> Integer ocurrencias x ys = genericLength (filter (==x) ys) -- 2ª solución -- =========== autodescriptivo2 :: Integer -> Bool autodescriptivo2 n = and (zipWith (==) (map digitToInt xs) [length (filter (==c) xs) | c <- ['0'..'9']]) where xs = show n -- Comprobación de equivalencia -- ============================ -- La propiedad es prop_autodescriptivo :: Positive Integer -> Bool prop_autodescriptivo (Positive n) = autodescriptivo1 n == autodescriptivo2 n -- La comprobación es -- λ> quickCheck prop_autodescriptivo -- +++ OK, passed 100 tests. -- Comparación de eficiencia -- ========================= -- La comparación es -- λ> [x | x <- [1..3*10^5], autodescriptivo1 x] -- [1210,2020,21200] -- (2.59 secs, 6,560,244,696 bytes) -- λ> [x | x <- [1..3*10^5], autodescriptivo2 x] -- [1210,2020,21200] -- (0.67 secs, 425,262,848 bytes) |
El código se encuentra en GitHub.