Definir la función
esPotenciaDeDos :: Integer -> Bool |
tal que (esPotenciaDeDos n) se verifica si n es una potencia de dos (suponiendo que n es mayor que 0). Por ejemplo.
esPotenciaDeDos 1 == True esPotenciaDeDos 2 == True esPotenciaDeDos 6 == False esPotenciaDeDos 8 == True esPotenciaDeDos 1024 == True esPotenciaDeDos 1026 == False esPotenciaDeDos (2^(10^8)) == True |
Definir la lista
numerosConDigitosPrimos :: [Integer] |
cuyos elementos son los números con todos sus dígitos primos. Por ejemplo,
λ> 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 |
Definir la función
reiteracion :: (a -> a) -> Int -> a -> a |
tal que (reiteracion f n x) es el resultado de aplicar n veces la función f a x. Por ejemplo,
reiteracion (+1) 10 5 == 15 reiteracion (+5) 10 0 == 50 reiteracion (*2) 4 1 == 16 reiteracion (5:) 4 [] == [5,5,5,5] |
import Test.QuickCheck (Fun (..), Positive (..), quickCheck) -- 1ª solución -- =========== reiteracion1 :: (a -> a) -> Int -> a -> a reiteracion1 _ 0 x = x reiteracion1 f n x = f (reiteracion1 f (n-1) x) -- 2ª solución -- =========== reiteracion2 :: (a -> a) -> Int -> a -> a reiteracion2 _ 0 = id reiteracion2 f n = f . reiteracion2 f (n-1) -- 3ª solución -- =========== reiteracion3 :: (a -> a) -> Int -> a -> a reiteracion3 _ 0 = id reiteracion3 f n | even n = reiteracion3 (f . f) (n `div` 2) | otherwise = f . reiteracion3 (f . f) (n `div` 2) -- 4ª solución -- =========== reiteracion4 :: (a -> a) -> Int -> a -> a reiteracion4 f n x = reiteraciones f x !! n reiteraciones :: (a -> a) -> a -> [a] reiteraciones f x = x : reiteraciones f (f x) -- 5ª solución -- =========== reiteracion5 :: (a -> a) -> Int -> a -> a reiteracion5 f n x = (iterate f x) !! n -- 6ª solución -- =========== -- Se puede eliminar los argumentos de la definición anterior como sigue: -- reiteracion4 f n x = iterate f x !! n -- reiteracion4 f n x = ((!!) (iterate f x)) n -- reiteracion4 f n x = (((!!) . (iterate f)) x) n -- reiteracion4 f n x = ((!!) . (iterate f)) x n -- reiteracion4 f n x = flip ((!!) . (iterate f)) n x -- reiteracion4 f = flip ((!!) . (iterate f)) -- reiteracion4 f = flip (((!!) .) (iterate f)) -- reiteracion4 f = flip (((!!) .) . iterate) f -- reiteracion4 f = (flip . ((!!) .) . iterate) f -- reiteracion4 = flip . ((!!) .) . iterate reiteracion6 :: (a -> a) -> Int -> a -> a reiteracion6 = flip . ((!!) .) . iterate -- Comprobación de equivalencia -- ============================ -- La propiedad es prop_reiteracion :: Fun Int Int -> Positive Int -> Int -> Bool prop_reiteracion (Fun _ f) (Positive n) x = all (== reiteracion1 f n x) [reiteracion2 f n x, reiteracion3 f n x, reiteracion4 f n x, reiteracion5 f n x, reiteracion6 f n x] -- La comprobación es -- λ> quickCheck prop_reiteracion -- +++ OK, passed 100 tests. -- Comparación de eficiencia -- ========================= -- La comparación es -- λ> reiteracion1 (+1) (10^7) 0 -- 10000000 -- (5.09 secs, 2,505,392,792 bytes) -- λ> reiteracion2 (+1) (10^7) 0 -- 10000000 -- (5.45 secs, 2,896,899,728 bytes) -- λ> reiteracion3 (+1) (10^7) 0 -- 10000000 -- (2.14 secs, 816,909,416 bytes) -- λ> reiteracion4 (+1) (10^7) 0 -- 10000000 -- (4.24 secs, 1,696,899,816 bytes) -- λ> reiteracion5 (+1) (10^7) 0 -- 10000000 -- (2.53 secs, 1,376,899,800 bytes) -- λ> reiteracion6 (+1) (10^7) 0 -- 10000000 -- (2.34 secs, 1,376,899,984 bytes) |
El código se encuentra en GitHub.
La elaboración de las soluciones se describe en el siguiente vídeo
Para cada entero positivo n, existe una única sucesión que empieza en 1, termina en n y en la que cada uno de sus elementos es el doble de su anterior o el doble más uno. Dicha sucesión se llama la sucesión duplicadora de n. Por ejemplo, la sucesión duplicadora de 13 es [1, 3, 6, 13], ya que
3 = 2*1 +1
6 = 2*3
13 = 2*6 +1 |
Definir la función
duplicadora :: Integer -> [Integer] |
tal que (duplicadora n) es la sucesión duplicadora de n. Por ejemplo,
duplicadora 13 == [1,3,6,13] duplicadora 17 == [1,2,4,8,17] length (duplicadora (10^40000)) == 132878 |
-- 1ª definición duplicadora :: Integer -> [Integer] duplicadora x = reverse (takeWhile (>=1) (iterate (`div` 2) x)) -- 2ª definición duplicadora2 :: Integer -> [Integer] duplicadora2 = reverse . takeWhile (>=1) . iterate (`div` 2) |
El complemento de un número positivo x se calcula por el siguiente procedimiento:
Definir las funciones
cadena :: Integer -> [Integer] conCadena :: Int -> [Integer] |
tales que
cadena 8 == []
cadena 7 == [7]
cadena 13 == [13,7]
cadena 643 == [643,557,443]
cadena 18127 == [18127,1873,127,73,67,53,47]
cadena 18181213 == [18181213,1818787,181213,18787,1213,787,613,587] |
take 6 (conCadena 3) == [23,31,61,67,103,307]
[head (conCadena n) | n <- [4..8]] == [37,43,157,18127,181873] |
import Data.Numbers.Primes -- (complemento x) es le complemento de x. Por ejemplo, -- complemento 1448 == 552 -- complemento 639 == 561 -- complemento 7 == 7 complemento :: Integer -> Integer complemento x = (div x c)*c - (rem x c) where c = 10^(length (show x) - 1) cadena :: Integer -> [Integer] cadena x | x < 10 && isPrime x = [x] | otherwise = takeWhile isPrime (iterate f x) where f x | x < 10 && isPrime x = 0 | otherwise = complemento x conCadena :: Int -> [Integer] conCadena n = [y | y <- primes, length (cadena y) == n] |
La sucesión de Loomis generada por un número entero positivo x es la sucesión cuyos términos se definen por
Los primeros términos de las primeras sucesiones de Loomis son
Se observa que a partir de un término todas coinciden con la generada por 1. Dicho término se llama el punto de convergencia. Por ejemplo,
Definir las siguientes funciones
sucLoomis :: Integer -> [Integer] convergencia :: Integer -> Integer graficaConvergencia :: [Integer] -> IO () |
tales que
λ> take 15 (sucLoomis 1)
[1,2,4,8,16,22,26,38,62,74,102,104,108,116,122]
λ> take 15 (sucLoomis 2)
[2,4,8,16,22,26,38,62,74,102,104,108,116,122,126]
λ> take 15 (sucLoomis 3)
[3,6,12,14,18,26,38,62,74,102,104,108,116,122,126]
λ> take 15 (sucLoomis 4)
[4,8,16,22,26,38,62,74,102,104,108,116,122,126,138]
λ> take 15 (sucLoomis 5)
[5,10,11,12,14,18,26,38,62,74,102,104,108,116,122]
λ> take 15 (sucLoomis 20)
[20,22,26,38,62,74,102,104,108,116,122,126,138,162,174]
λ> take 15 (sucLoomis 100)
[100,101,102,104,108,116,122,126,138,162,174,202,206,218,234]
λ> sucLoomis 1 !! (2*10^5)
235180736652 |
convergencia 2 == 2
convergencia 3 == 26
convergencia 4 == 4
convergencia 17 == 38
convergencia 19 == 102
convergencia 43 == 162
convergencia 27 == 202
convergencia 58 == 474
convergencia 63 == 150056
convergencia 81 == 150056
convergencia 89 == 150056
convergencia (10^12) == 1000101125092 |
import Data.List ((\\)) import Data.Char (digitToInt) import Graphics.Gnuplot.Simple (plotList, Attribute (Key, Title, XRange, PNG)) -- 1ª definición de sucLoomis -- ========================== sucLoomis :: Integer -> [Integer] sucLoomis x = map (loomis x) [0..] loomis :: Integer -> Integer -> Integer loomis x 0 = x loomis x n = y + productoDigitosNoNulos y where y = loomis x (n-1) productoDigitosNoNulos :: Integer -> Integer productoDigitosNoNulos = product . digitosNoNulos digitosNoNulos :: Integer -> [Integer] digitosNoNulos x = [read [c] | c <- show x, c /= '0'] -- 2ª definición de sucLoomis -- ========================== sucLoomis2 :: Integer -> [Integer] sucLoomis2 = iterate siguienteLoomis siguienteLoomis :: Integer -> Integer siguienteLoomis y = y + productoDigitosNoNulos y -- 3ª definición de sucLoomis -- ========================== sucLoomis3 :: Integer -> [Integer] sucLoomis3 = iterate ((+) <*> product . map (toInteger . digitToInt) . filter (/= '0') . show) -- Comparación de eficiencia -- ========================= -- λ> sucLoomis 1 !! 30000 -- 6571272766 -- (2.45 secs, 987,955,944 bytes) -- λ> sucLoomis2 1 !! 30000 -- 6571272766 -- (2.26 secs, 979,543,328 bytes) -- λ> sucLoomis3 1 !! 30000 -- 6571272766 -- (0.31 secs, 88,323,832 bytes) -- 1ª definición de convergencia -- ============================= convergencia1 :: Integer -> Integer convergencia1 x = head (dropWhile noEnSucLoomisDe1 (sucLoomis x)) noEnSucLoomisDe1 :: Integer -> Bool noEnSucLoomisDe1 x = not (pertenece x sucLoomisDe1) sucLoomisDe1 :: [Integer] sucLoomisDe1 = sucLoomis 1 pertenece :: Integer -> [Integer] -> Bool pertenece x ys = x == head (dropWhile (<x) ys) -- 2ª definición de convergencia -- ============================= convergencia2 :: Integer -> Integer convergencia2 = aux (sucLoomis3 1) . sucLoomis3 where aux as@(x:xs) bs@(y:ys) | x == y = x | x < y = aux xs bs | otherwise = aux as ys -- 3ª definición de convergencia -- ============================= convergencia3 :: Integer -> Integer convergencia3 = head . interseccion (sucLoomis3 1) . sucLoomis3 -- (interseccion xs ys) es la intersección entre las listas ordenadas xs -- e ys. Por ejemplo, -- λ> take 10 (interseccion (sucLoomis3 1) (sucLoomis3 2)) -- [2,4,8,16,22,26,38,62,74,102] interseccion :: Ord a => [a] -> [a] -> [a] interseccion = aux where aux as@(x:xs) bs@(y:ys) = case compare x y of LT -> aux xs bs EQ -> x : aux xs ys GT -> aux as ys aux _ _ = [] -- 4ª definición de convergencia -- ============================= convergencia4 :: Integer -> Integer convergencia4 x = perteneceA (sucLoomis3 x) 1 where perteneceA (y:ys) n | y == c = y | otherwise = perteneceA ys c where c = head $ dropWhile (< y) $ sucLoomis3 n -- Comparación de eficiencia -- ========================= -- λ> convergencia1 (10^4) -- 150056 -- (2.94 secs, 1,260,809,808 bytes) -- λ> convergencia2 (10^4) -- 150056 -- (0.03 secs, 700,240 bytes) -- λ> convergencia3 (10^4) -- 150056 -- (0.03 secs, 1,165,496 bytes) -- λ> convergencia4 (10^4) -- 150056 -- (0.02 secs, 1,119,648 bytes) -- -- λ> convergencia2 (10^12) -- 1000101125092 -- (1.81 secs, 714,901,080 bytes) -- λ> convergencia3 (10^12) -- 1000101125092 -- (1.92 secs, 744,932,184 bytes) -- λ> convergencia4 (10^12) -- 1000101125092 -- (1.82 secs, 941,053,328 bytes) -- Definición de graficaConvergencia -- ================================== graficaConvergencia :: [Integer] -> IO () graficaConvergencia xs = plotList [ Key Nothing , Title "Convergencia de sucesiones de Loomis" , XRange (fromIntegral (minimum xs),fromIntegral (maximum xs)) , PNG "Las_sucesiones_de_Loomis_2.png" ] [(x,convergencia2 x) | x <- xs] |
Los números de Perrin se definen por la elación de recurrencia
P(n) = P(n - 2) + P(n - 3) si n > 2, |
con los valores iniciales
P(0) = 3, P(1) = 0 y P(2) = 2. |
Definir la sucesión
sucPerrin :: [Integer] |
cuyos elementos son los números de Perrin. Por ejemplo,
λ> take 15 sucPerrin [3,0,2,3,2,5,5,7,10,12,17,22,29,39,51] λ> length (show (sucPerrin !! (2*10^5))) 24425 |
Comprobar con QuickCheck si se verifica la siguiente propiedad: para todo entero n > 1, el n-ésimo término de la sucesión de Perrin es divisible por n si y sólo si n es primo.
import Data.List (genericIndex, unfoldr) import Data.Numbers.Primes (isPrime) import Test.QuickCheck -- 1ª solución sucPerrin1 :: [Integer] sucPerrin1 = 3 : 0 : 2 : zipWith (+) sucPerrin1 (tail sucPerrin1) -- 2ª solución sucPerrin2 :: [Integer] sucPerrin2 = [x | (x,_,_) <- iterate op (3,0,2)] where op (a,b,c) = (b,c,a+b) -- 3ª solución sucPerrin3 :: [Integer] sucPerrin3 = unfoldr (\(a, (b,c)) -> Just (a, (b,(c,a+b)))) (3,(0,2)) -- 4ª solución sucPerrin4 :: [Integer] sucPerrin4 = [vectorPerrin n ! n | n <- [0..]] vectorPerrin :: Integer -> Array Integer Integer vectorPerrin n = v where v = array (0,n) [(i,f i) | i <- [0..n]] f 0 = 3 f 1 = 0 f 2 = 2 f i = v ! (i-2) + v ! (i-3) -- Comparación de eficiencia -- λ> length (show (sucPerrin1 !! (3*10^5))) -- 36638 -- (1.62 secs, 2,366,238,984 bytes) -- λ> length (show (sucPerrin2 !! (3*10^5))) -- 36638 -- (1.40 secs, 2,428,701,384 bytes) -- λ> length (show (sucPerrin3 !! (3*10^5))) -- 36638 -- (1.14 secs, 2,409,504,864 bytes) -- λ> length (show (sucPerrin4 !! (3*10^5))) -- 36638 -- (1.78 secs, 2,585,400,776 bytes) -- Usaremos la 3ª sucPerrin :: [Integer] sucPerrin = sucPerrin3 -- La propiedad es conjeturaPerrin :: Integer -> Property conjeturaPerrin n = n > 1 ==> (perrin n `mod` n == 0) == isPrime n -- (perrin n) es el n-ésimo término de la sucesión de Perrin. Por -- ejemplo, -- perrin 4 == 2 -- perrin 5 == 5 -- perrin 6 == 5 perrin :: Integer -> Integer perrin n = sucPerrin `genericIndex` n -- La comprobación es -- λ> quickCheck conjeturaPerrin -- +++ OK, passed 100 tests. -- Nota: Aunque QuickCheck no haya encontrado contraejemplos, la -- propiedad no es cierta. Sólo lo es una de las implicaciones: si n es -- primo, entonces el n-ésimo término de la sucesión de Perrin es -- divisible por n. La otra es falsa y los primeros contraejemplos son -- 271441, 904631, 16532714, 24658561, 27422714, 27664033, 46672291 |
Un niño está jugando con una pelota en el noveno piso de un edificio alto. La altura de este piso, h, es conocida. Deja caer la pelota por la ventana. La pelota rebota una r-ésima parte de su altura (por ejemplo, dos tercios de su altura). Su madre mira por una ventana a w metros del suelo (por ejemplo, a 1.5 metros). ¿Cuántas veces verá la madre a la pelota pasar frente a su ventana incluyendo cuando está cayendo y rebotando?
Se deben cumplir tres condiciones para que el experimento sea válido:
Definir la función
numeroAvistamientos :: Double -> Double -> Double -> Integer |
tal que (numeroAvistamientos h r v) es el número de avistamientos de la pelota si se cumplen las tres condiciones anteriores y es -1 en caso contrario. Por ejemplo,
numeroAvistamientos 3 0.66 1.5 == 3 numeroAvistamientos 30 0.66 1.5 == 15 numeroAvistamientos (-3) 0.66 1.5 == -1 numeroAvistamientos 3 (-1) 1.5 == -1 numeroAvistamientos 3 2 1.5 == -1 numeroAvistamientos 3 0.5 (-1) == -1 numeroAvistamientos 3 0.5 4 == -1 |
import Data.List (genericLength) -- 1ª solución -- ============ numeroAvistamientos :: Double -> Double -> Double -> Integer numeroAvistamientos h r v | adecuados h r v = 2 * n - 1 | otherwise = -1 where n = genericLength (takeWhile (>=v) (iterate (*r) h)) -- (adecuados h r v) se verifica si los datos cumplen las condiciones -- para que el experimento sea válido. adecuados :: Double -> Double -> Double -> Bool adecuados h r v = h > 0 && 0 < r && r < 1 && 0 < v && v < h -- 2ª solución -- =========== numeroAvistamientos2 :: Double -> Double -> Double -> Integer numeroAvistamientos2 h r v | adecuados h r v = 2 + numeroAvistamientos2 (h * r) r v | otherwise = -1 -- 3ª solución numeroAvistamientos3 :: Double -> Double -> Double -> Integer numeroAvistamientos3 h r v | adecuados h r v = 1 + 2 * floor (logBase r (v / h)) | otherwise = -1 |
“Los patrones del matemático, como los del pintor o el poeta deben ser hermosos; las ideas, como los colores o las palabras deben encajar de manera armoniosa. La belleza es la primera prueba: no hay lugar permanente en este mundo para las matemáticas feas.”
Sea p un número primo. Toma un número natural positivo, si es divisible entre un número primo menor que p divídelo entre el menor de dicho divisores, y en otro caso multiplícalo por p y súmale uno; si el resultado no es igual a uno, repite el proceso. Por ejemplo, para p = 7 y empezando en 42 el proceso es
42 -> 21 [= 42/2] -> 7 [= 21/3] -> 50 [= 7*7+1] -> 25 [= 50/5] -> 5 [= 25/5] -> 1 [= 5/5] |
La conjetura de Collatz generalizada afirma que este proceso siempre acaba en un número finito de pasos.
Definir la función
collatzGeneral :: Integer -> Integer -> [Integer] |
tal que (collatzGeneral p x) es la sucesión de los elementos obtenidos en el proceso anterior para el primo p enpezando en x. Por ejemplo,
take 15 (collatzGeneral 7 42) == [42,21,7,50,25,5,1,8,4,2,1,8,4,2,1] take 15 (collatzGeneral 3 6) == [6,3,10,5,16,8,4,2,1,4,2,1,4,2,1] take 15 (collatzGeneral 5 6) == [6,3,1,6,3,1,6,3,1,6,3,1,6,3,1] take 15 (collatzGeneral 7 6) == [6,3,1,8,4,2,1,8,4,2,1,8,4,2,1] take 15 (collatzGeneral 9 6) == [6,3,1,10,5,1,10,5,1,10,5,1,10,5,1] |
Comprobar con QuickCheck que se verifica la conjetura de Collatz generalizada; es decir, para todos enteros positivos n, x si p es el primo n-ésimo entonces 1 pertenece a (collatzGeneral p x).
Nota: El ejercicio etá basado en el artículo Los primos de la conjetura de Collatz publicado la semana pasada por Francisco R. Villatoro en su blog La Ciencia de la Mula Francis.
import Data.Numbers.Primes (primeFactors, primes) import Test.QuickCheck collatzGeneral :: Integer -> Integer -> [Integer] collatzGeneral p x = iterate (siguiente p) x siguiente :: Integer -> Integer -> Integer siguiente p x | null xs = p * x + 1 | otherwise = x `div` head xs where xs = takeWhile (<p) (primeFactors x) prop_collatzGeneral :: Int -> Integer -> Property prop_collatzGeneral n x = n > 0 && x > 0 ==> 1 `elem` collatzGeneral p x where p = primes !! n -- La comprobación es -- λ> quickCheck prop_collatzGeneral -- +++ OK, passed 100 tests. |
“Las matemáticas son la ciencia que utiliza palabras fáciles para ideas difíciles.”
El triágulo de Bell es el triángulo numérico, cuya primera fila es [1] y en cada fila, el primer elemento es el último de la fila anterior y el elemento en la posición j se obtiene sumando el elemento anterior de su misma fila y de la fila anterior. Sus primeras filas son
1 1 2 2 3 5 5 7 10 15 15 20 27 37 52 52 67 87 114 151 203 |
Definir la función
trianguloDeBell :: [[Integer]] |
tal que trianguloDeBell es la lista con las filas de dicho triángulo. Por ejemplo
λ> take 5 trianguloDeBell [[1],[1,2],[2,3,5],[5,7,10,15],[15,20,27,37,52]] |
Comprobar con QuickCheck que los números que aparecen en la primera columna del triángulo coinciden con los números de Bell; es decir, el primer elemento de la n-ésima fila es el n-ésimo número de Bell.
import Data.List (genericIndex, genericLength) import Test.QuickCheck trianguloDeBell :: [[Integer]] trianguloDeBell = iterate siguiente [1] -- (siguiente xs) es la fila siguiente de xs en el triángulo de -- Bell. Por ejemplo, -- siguiente [1] == [1,2] -- siguiente [1,2] == [2,3,5] -- siguiente [2,3,5] == [5,7,10,15] siguiente :: [Integer] -> [Integer] siguiente xs = last xs : zipWith (+) xs (siguiente xs) -- Propiedad -- ========= -- La propiedad es prop_TrianguloDeBell :: Integer -> Property prop_TrianguloDeBell n = n > 0 ==> head (trianguloDeBell `genericIndex` n) == bell n -- (bell n) es el n-ésimo número de Bell definido en el ejercicio -- anterior. bell :: Integer -> Integer bell n = genericLength (particiones [1..n]) particiones :: [a] -> [[[a]]] particiones [] = [[]] particiones (x:xs) = concat [([x] : yss) : inserta x yss | yss <- ysss] where ysss = particiones xs inserta :: a -> [[a]] -> [[[a]]] inserta _ [] = [] inserta x (ys:yss) = ((x:ys):yss) : [ys : zs | zs <- inserta x yss] -- La comprobación es -- λ> quickCheckWith (stdArgs {maxSize=10}) prop_TrianguloDeBell -- +++ OK, passed 100 tests. |
“La ciencia es lo que entendemos lo suficientemente bien como para explicarle a una computadora. El arte es todo lo demás.”
José A. Alonso