El período de una lista xs es la lista más corta ys tal que xs se puede obtener concatenando varias veces la lista ys. Por ejemplo, el período «abababab» es «ab» ya que «abababab» se obtiene repitiendo tres veces la lista «ab».
Definir la función
|
1 |
periodo :: Eq a => [a] -> [a] |
tal que (periodo xs) es el período de xs. Por ejemplo,
|
1 2 3 4 |
periodo "ababab" == "ab" periodo "buenobueno" == "bueno" periodo "oooooo" == "o" periodo "sevilla" == "sevilla" |
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 |
import Data.List (isPrefixOf, inits) -- 1ª solución -- =========== periodo1 :: Eq a => [a] -> [a] periodo1 xs = take n xs where l = length xs n = head [m | m <- divisores l, concat (replicate (l `div` m) (take m xs)) == xs] -- (divisores n) es la lista de los divisores de n. Por ejemplo, -- divisores 96 == [1,2,3,4,6,8,12,16,24,32,48,96] divisores :: Int -> [Int] divisores n = [x | x <- [1..n], n `mod` x == 0] -- 2ª solución -- =========== periodo2 :: Eq a => [a] -> [a] periodo2 xs = take n xs where l = length xs n = head [m | m <- divisores l, xs `isPrefixOf` cycle (take m xs)] |
Un capicúa es un número que es igual leído de izquierda a derecha que de derecha a izquierda.
Definir la función
|
1 |
mayorCapicuaP :: Integer -> Integer |
tal que (mayorCapicuaP n) es el mayor capicúa que es el producto de dos números de n cifras. Por ejemplo,
|
1 2 3 4 5 6 |
mayorCapicuaP 2 == 9009 mayorCapicuaP 3 == 906609 mayorCapicuaP 4 == 99000099 mayorCapicuaP 5 == 9966006699 mayorCapicuaP 6 == 999000000999 mayorCapicuaP 7 == 99956644665999 |
|
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 183 184 185 186 |
-- 1ª solución -- =========== mayorCapicuaP1 :: Integer -> Integer mayorCapicuaP1 n = head (capicuasP n) -- (capicuasP n) es la lista de las capicúas de 2*n cifras que -- pueden escribirse como productos de dos números de n cifras. Por -- ejemplo, Por ejemplo, -- ghci> capicuasP 2 -- [9009,8448,8118,8008,7227,7007,6776,6336,6006,5775,5445,5335, -- 5225,5115,5005,4884,4774,4664,4554,4224,4004,3773,3663,3003, -- 2992,2772,2552,2442,2332,2112,2002,1881,1771,1551,1221,1001] capicuasP n = [x | x <- capicuas n, not (null (productosDosNumerosCifras n x))] -- (capicuas n) es la lista de las capicúas de 2*n cifras de mayor a -- menor. Por ejemplo, -- capicuas 1 == [99,88,77,66,55,44,33,22,11] -- take 7 (capicuas 2) == [9999,9889,9779,9669,9559,9449,9339] capicuas :: Integer -> [Integer] capicuas n = [capicua x | x <- numerosCifras n] -- (numerosCifras n) es la lista de los números de n cifras de mayor a -- menor. Por ejemplo, -- numerosCifras 1 == [9,8,7,6,5,4,3,2,1] -- take 7 (numerosCifras 2) == [99,98,97,96,95,94,93] -- take 7 (numerosCifras 3) == [999,998,997,996,995,994,993] numerosCifras :: Integer -> [Integer] numerosCifras n = [a,a-1..b] where a = 10^n-1 b = 10^(n-1) -- (capicua n) es la capicúa formada añadiendo el inverso de n a -- continuación de n. Por ejemplo, -- capicua 93 == 9339 capicua :: Integer -> Integer capicua n = read (xs ++ (reverse xs)) where xs = show n -- (productosDosNumerosCifras n x) es la lista de los números y de n -- cifras tales que existe un z de n cifras y x es el producto de y por -- z. Por ejemplo, -- productosDosNumerosCifras 2 9009 == [99,91] productosDosNumerosCifras n x = [y | y <- numeros, mod x y == 0, div x y `elem` numeros] where numeros = numerosCifras n -- 2ª solución -- =========== mayorCapicuaP2 :: Integer -> Integer mayorCapicuaP2 n = maximum [x*y | x <- [a,a-1..b], y <- [a,a-1..b], esCapicua (x*y)] where a = 10^n-1 b = 10^(n-1) -- (esCapicua x) se verifica si x es capicúa. Por ejemplo, -- esCapicua 353 == True -- esCapicua 357 == False esCapicua :: Integer -> Bool esCapicua n = xs == reverse xs where xs = show n -- 3ª solución -- =========== mayorCapicuaP3 :: Integer -> Integer mayorCapicuaP3 n = maximum [x*y | (x,y) <- pares a b, esCapicua (x*y)] where a = 10^n-1 b = 10^(n-1) -- (pares a b) es la lista de los pares de números entre a y b de forma -- que su suma es decreciente. Por ejemplo, -- pares 9 7 == [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)] pares a b = [(x,z-x) | z <- [a1,a1-1..b1], x <- [a,a-1..b], x <= z-x, z-x <= a] where a1 = 2*a b1 = 2*b -- 4ª solución -- =========== mayorCapicuaP4 :: Integer -> Integer mayorCapicuaP4 n = maximum [x | y <- [a..b], z <- [y..b], let x = y * z, let s = show x, s == reverse s] where a = 10^(n-1) b = 10^n-1 -- 5ª solución -- =========== mayorCapicuaP5 :: Integer -> Integer mayorCapicuaP5 n = maximum [x*y | (x,y) <- pares2 b a, esCapicua (x*y)] where a = 10^(n-1) b = 10^n-1 -- (pares2 a b) es la lista de los pares de números entre a y b de forma -- que su suma es decreciente. Por ejemplo, -- pares2 9 7 == [(9,9),(8,9),(8,8),(7,9),(7,8),(7,7)] pares2 a b = [(x,y) | x <- [a,a-1..b], y <- [a,a-1..x]] -- 6ª solución -- =========== mayorCapicuaP6 :: Integer -> Integer mayorCapicuaP6 n = maximum [x*y | x <- [a..b], y <- [x..b] , esCapicua (x*y)] where a = 10^(n-1) b = 10^n-1 -- (cifras n) es la lista de las cifras de n en orden inverso. Por -- ejemplo, -- cifras 325 == [5,2,3] cifras :: Integer -> [Integer] cifras n | n < 10 = [n] | otherwise = (ultima n) : (cifras (quitarUltima n)) -- (ultima n) es la última cifra de n. Por ejemplo, -- ultima 325 == 5 ultima :: Integer -> Integer ultima n = n - (n `div` 10)*10 -- (quitarUltima n) es el número obtenido al quitarle a n su última -- cifra. Por ejemplo, -- quitarUltima 325 => 32 quitarUltima :: Integer -> Integer quitarUltima n = (n - (ultima n)) `div` 10 -- 7ª solución -- =========== mayorCapicuaP7 :: Integer -> Integer mayorCapicuaP7 n = head [x | x <- capicuas n, esFactorizable x n] -- (esFactorizable x n) se verifica si x se puede escribir como producto -- de dos números de n dígitos. Por ejemplo, -- esFactorizable 1219 2 == True -- esFactorizable 1217 2 == False esFactorizable x n = aux i x where b = 10^n-1 i = floor (sqrt (fromIntegral x)) aux i x | i > b = False | x `mod` i == 0 = x `div` i < b | otherwise = aux (i+1) x -- Comparación de eficiencia -- ========================= -- λ> mayorCapicuaP1 3 -- 906609 -- (0.07 secs, 18,248,224 bytes) -- λ> mayorCapicuaP2 3 -- 906609 -- (0.51 secs, 555,695,720 bytes) -- λ> mayorCapicuaP3 3 -- 906609 -- (0.96 secs, 780,794,768 bytes) -- λ> mayorCapicuaP4 3 -- 906609 -- (0.24 secs, 255,445,448 bytes) -- λ> mayorCapicuaP5 3 -- 906609 -- (0.33 secs, 317,304,080 bytes) -- λ> mayorCapicuaP6 3 -- 906609 -- (0.26 secs, 274,987,472 bytes) -- λ> mayorCapicuaP7 3 -- 906609 -- (0.02 secs, 1,807,720 bytes) -- -- λ> mayorCapicuaP1 5 -- 9966006699 -- (9.90 secs, 6,349,454,544 bytes) -- λ> mayorCapicuaP7 5 -- 9966006699 -- (0.06 secs, 15,958,616 bytes) |
Un hotel dispone de n habitaciones y n camareros. Los camareros tienen la costumbre de cambiar de estado las puertas (es decir, abrir las cerradas y cerrar las abiertas). El proceso es el siguiente:
Por ejemplo, para n = 5
|
1 2 3 4 5 6 7 |
Pase | Puerta 1 | Puerta 2 | Puerta 3 | Puerta 4 | Puerta 5 Inicial | Cerrada | Cerrada | Cerrada | Cerrada | Cerrada Pase 1 | Abierta | Abierta | Abierta | Abierta | Abierta Pase 2 | Abierta | Cerrada | Abierta | Cerrada | Abierta Pase 3 | Abierta | Cerrada | Cerrada | Cerrada | Abierta Pase 4 | Abierta | Cerrada | Cerrada | Abierta | Abierta Pase 5 | Abierta | Cerrada | Cerrada | Abierta | Cerrada |
Los estados de las puertas se representan por el siguiente tipo de datos
|
1 |
data Estado = Abierta | Cerrada deriving Show |
Definir la función
|
1 |
final :: Int -> [Estado] |
tal que (final n) es la lista de los estados de las n puertas después de que hayan pasado los n camareros. Por ejemplo,
|
1 2 3 4 |
ghci> final 5 [Abierta,Cerrada,Cerrada,Abierta,Cerrada] ghci> final 7 [Abierta,Cerrada,Cerrada,Abierta,Cerrada,Cerrada,Cerrada] |
[schedule on=’2020-06-05′ at=»06:00″]
|
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 |
-- 1ª solución -- =========== data Estado = Abierta | Cerrada deriving (Eq, Show) cambia Abierta = Cerrada cambia Cerrada = Abierta -- (inicial n) es el estado inicial para el problema de las n -- habitaciones. Por ejemplo, -- inicial 5 == [Cerrada,Cerrada,Cerrada,Cerrada,Cerrada] inicial :: Int -> [Estado] inicial n = replicate n Cerrada -- (pase k es) es la lista de los estados de las puertas después de pasar el -- camarero k que las encuentra en los estados es. Por ejemplo, -- ghci> pase 1 (inicial 5) -- [Abierta,Abierta,Abierta,Abierta,Abierta] -- ghci> pase 2 it -- [Abierta,Cerrada,Abierta,Cerrada,Abierta] -- ghci> pase 3 it -- [Abierta,Cerrada,Cerrada,Cerrada,Abierta] -- ghci> pase 4 it -- [Abierta,Cerrada,Cerrada,Abierta,Abierta] -- ghci> pase 5 it -- [Abierta,Cerrada,Cerrada,Abierta,Cerrada] pase :: [Estado] -> Int -> [Estado] pase es k = zipWith cambiaK es [1..] where cambiaK e n | n `mod` k == 0 = cambia e | otherwise = e final :: Int -> [Estado] final n = aux [1..n] (inicial n) where aux [] es = es aux (k:ks) es = aux ks (pase es k) -- 2ª solución -- =========== final2 :: Int -> [Estado] final2 n = foldl pase (inicial n) [1..n] -- 3ª solución -- ============= final3 :: Int -> [Estado] final3 n = map f [1..n] where f x | even (length (divisores x)) = Cerrada | otherwise = Abierta divisores :: Int -> [Int] divisores n = [x | x <- [1..n], n `mod` x == 0] -- 4ª solución -- =========== -- En primer lugar, vamos a determinar la lista de las posiciones -- (comenzando a contar en 1) de las puertas que quedan abierta en el -- problema de las n puertas. posicionesAbiertas :: Int -> [Int] posicionesAbiertas n = [x | (x,y) <- zip [1..] (final n), y == Abierta] -- Al calcularlas, -- ghci> posicionesAbiertas 200 -- [1,4,9,16,25,36,49,64,81,100,121,144,169,196] -- Se observa las que quedan abiertas son las que sus posiciones son -- cuadrados perfectos. Usando esta observación se construye la -- siguiente definición final4 :: Int -> [Estado] final4 n = aux [1..n] [k*k | k <- [1..]] where aux (x:xs) (y:ys) | x == y = Abierta : aux xs ys aux (x:xs) ys = Cerrada : aux xs ys aux [] _ = [] -- --------------------------------------------------------------------- -- § Comparación de eficiencia -- -- --------------------------------------------------------------------- -- ghci> last (final 1000) -- Cerrada -- (0.23 secs, 218727400 bytes) -- ghci> last (final 2000) -- Cerrada -- (1.78 secs, 868883080 bytes) -- ghci> last (final2 1000) -- Cerrada -- (0.08 secs, 218729392 bytes) -- ghci> last (final2 2000) -- Cerrada -- (1.77 secs, 868948600 bytes) -- ghci> last (final3 1000) -- Cerrada -- (0.01 secs, 1029256 bytes) -- ghci> last (final3 2000) -- Cerrada -- (0.01 secs, 2121984 bytes) -- ghci> last (final4 1000) -- Cerrada -- (0.01 secs, 1029328 bytes) -- ghci> last (final4 2000) -- Cerrada -- (0.01 secs, 1578504 bytes) -- ghci> last (final3 10000) -- Abierta -- (0.01 secs, 4670104 bytes) -- ghci> last (final3 100000) -- Cerrada -- (0.09 secs, 38717032 bytes) -- ghci> last (final3 1000000) -- Abierta -- (1.27 secs, 377100832 bytes) -- ghci> last (final4 1000000) -- Abierta -- (1.41 secs, 273292448 bytes) |
El sistema D’Hondt es una fórmula creada por Victor d’Hondt, que permite obtener el número de cargos electos asignados a las candidaturas, en proporción a los votos conseguidos.
Tras el recuento de los votos, se calcula una serie de divisores para cada partido. La fórmula de los divisores es V/N, donde V representa el número total de votos recibidos por el partido, y N representa cada uno de los números enteros desde 1 hasta el número de cargos electos de la circunscripción objeto de escrutinio. Una vez realizadas las divisiones de los votos de cada partido por cada uno de los divisores desde 1 hasta N, la asignación de cargos electos se hace ordenando los cocientes de las divisiones de mayor a menor y asignando a cada uno un escaño hasta que éstos se agoten
Definir la función
|
1 |
reparto :: Int -> [Int] -> [(Int,Int)] |
tal que (reparto n vs) es la lista de los pares formados por los números de los partidos y el número de escaño que les corresponden al repartir n escaños en función de la lista de sus votos. Por ejemplo,
|
1 2 3 4 |
ghci> reparto 7 [340000,280000,160000,60000,15000] [(1,3),(2,3),(3,1)] ghci> reparto 21 [391000,311000,184000,73000,27000,12000,2000] [(1,9),(2,7),(3,4),(4,1)] |
es decir, en el primer ejemplo,
|
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 |
import Data.List (sort, group) -- Para los ejemplos que siguen, se usará la siguiente ditribución de -- votos entre 5 partidos. ejVotos :: [Int] ejVotos = [340000,280000,160000,60000,15000] -- 1ª solución -- =========== reparto :: Int -> [Int] -> [(Int,Int)] reparto n vs = [(x,1 + length xs) | (x:xs) <- group (sort (repartoAux n vs))] -- (repartoAux n vs) es el número de los partidos, cuyos votos son vs, que -- obtienen los n escaños. Por ejemplo, -- ghci> repartoAux 7 ejVotos -- [1,2,1,3,2,1,2] repartoAux :: Int -> [Int] -> [Int] repartoAux n vs = map snd (repartoAux' n vs) -- (repartoAux' n vs) es la lista formada por los n restos mayores -- correspondientes a la lista de votos vs. Por ejemplo, -- ghci> repartoAux' 7 ejVotos -- [(340000,1),(280000,2),(170000,1),(160000,3),(140000,2),(113333,1), -- (93333,2)] repartoAux' :: Int -> [Int] -> [(Int,Int)] repartoAux' n vs = take n (reverse (sort (concatMap (restos n) (votosPartidos vs)))) -- (votosPartidos vs) es la lista con los pares formados por los votos y -- el número de cada partido. Por ejemplo, -- ghci> votosPartidos ejVotos -- [(340000,1),(280000,2),(160000,3),(60000,4),(15000,5)] votosPartidos :: [Int] -> [(Int,Int)] votosPartidos vs = zip vs [1..] -- (restos n (x,i)) es la lista obtenidas dividiendo n entre 1, 2,..., n. -- Por ejemplo, -- ghci> restos 5 (340000,1) -- [(340000,1),(170000,1),(113333,1),(85000,1),(68000,1)] restos :: Int -> (Int,Int) -> [(Int,Int)] restos n (x,i) = [(x `div` k,i) | k <- [1..n]] -- 2ª solución -- =========== reparto2 :: Int -> [Int] -> [(Int,Int)] reparto2 n xs = ( map (\x -> (head x, length x)) . group . sort . map snd . take n . reverse . sort ) [(x `div` i, p) | (x,p) <- zip xs [1..], i <- [1..n]] |
La conjetura de las familias estables por uniones fue planteada por Péter Frankl en 1979 y aún sigue abierta.
Una familia de conjuntos es estable por uniones si la unión de dos conjuntos cualesquiera de la familia pertenece a la familia. Por ejemplo, {∅, {1}, {2}, {1,2}, {1,3}, {1,2,3}} es estable por uniones; pero {{1}, {2}, {1,3}, {1,2,3}} no lo es.
La conjetura afirma que toda familia no vacía estable por uniones y distinta de {∅} posee algún elemento que pertenece al menos a la mitad de los conjuntos de la familia.
Definir las funciones
|
1 2 3 4 |
esEstable :: Ord a => Set (Set a) -> Bool familiasEstables :: Ord a => Set a -> Set (Set (Set a)) mayoritarios :: Ord a => Set (Set a) -> [a] conjeturaFrankl :: Int -> Bool |
tales que
|
1 2 3 4 5 6 |
λ> esEstable (fromList [empty, fromList [1,2], fromList [1..5]]) True λ> esEstable (fromList [empty, fromList [1,7], fromList [1..5]]) False λ> esEstable (fromList [fromList [1,2], singleton 3, fromList [1..3]]) True |
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 |
λ> familiasEstables (fromList [1..2]) fromList [ fromList [] , fromList [fromList []] , fromList [fromList [],fromList [1]] , fromList [fromList [],fromList [1],fromList [1,2]], fromList [fromList [],fromList [1],fromList [1,2],fromList [2]] , fromList [fromList [],fromList [1,2]] , fromList [fromList [],fromList [1,2],fromList [2]] , fromList [fromList [],fromList [2]] , fromList [fromList [1]] , fromList [fromList [1],fromList [1,2]] , fromList [fromList [1],fromList [1,2],fromList [2]] , fromList [fromList [1,2]] , fromList [fromList [1,2],fromList [2]] , fromList [fromList [2]]] λ> size (familiasEstables (fromList [1,2])) 14 λ> size (familiasEstables (fromList [1..3])) 122 λ> size (familiasEstables (fromList [1..4])) 4960 |
|
1 2 |
mayoritarios (fromList [empty, fromList [1,3], fromList [3,5]]) == [3] mayoritarios (fromList [empty, fromList [1,3], fromList [4,5]]) == [] |
|
1 2 3 |
conjeturaFrankl 2 == True conjeturaFrankl 3 == True conjeturaFrankl 4 == True |
|
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 |
import Data.Set as S ( Set , delete , deleteFindMin , empty , filter , fromList , insert , map , member , null , singleton , size , toList , union , unions ) import Data.List as L ( filter , null ) esEstable :: Ord a => Set (Set a) -> Bool esEstable xss = and [ys `S.union` zs `member` xss | (ys,yss) <- selecciones xss , zs <- toList yss] -- (seleccciones xs) es la lista de los pares formada por un elemento de -- xs y los restantes elementos. Por ejemplo, -- λ> selecciones (fromList [3,2,5]) -- [(2,fromList [3,5]),(3,fromList [2,5]),(5,fromList [2,3])] selecciones :: Ord a => Set a -> [(a,Set a)] selecciones xs = [(x,delete x xs) | x <- toList xs] familiasEstables :: Ord a => Set a -> Set (Set (Set a)) familiasEstables xss = S.filter esEstable (familias xss) -- (familias c) es la familia formadas con elementos de c. Por ejemplo, -- λ> mapM_ print (familias (fromList [1,2])) -- fromList [] -- fromList [fromList []] -- fromList [fromList [],fromList [1]] -- fromList [fromList [],fromList [1],fromList [1,2]] -- fromList [fromList [],fromList [1],fromList [1,2],fromList [2]] -- fromList [fromList [],fromList [1],fromList [2]] -- fromList [fromList [],fromList [1,2]] -- fromList [fromList [],fromList [1,2],fromList [2]] -- fromList [fromList [],fromList [2]] -- fromList [fromList [1]] -- fromList [fromList [1],fromList [1,2]] -- fromList [fromList [1],fromList [1,2],fromList [2]] -- fromList [fromList [1],fromList [2]] -- fromList [fromList [1,2]] -- fromList [fromList [1,2],fromList [2]] -- fromList [fromList [2]] -- λ> size (familias (fromList [1,2])) -- 16 -- λ> size (familias (fromList [1,2,3])) -- 256 -- λ> size (familias (fromList [1,2,3,4])) -- 65536 familias :: Ord a => Set a -> Set (Set (Set a)) familias c = subconjuntos (subconjuntos c) -- (subconjuntos c) es el conjunto de los subconjuntos de c. Por ejemplo, -- λ> mapM_ print (subconjuntos (fromList [1,2,3])) -- fromList [] -- fromList [1] -- fromList [1,2] -- fromList [1,2,3] -- fromList [1,3] -- fromList [2] -- fromList [2,3] -- fromList [3] subconjuntos :: Ord a => Set a -> Set (Set a) subconjuntos c | S.null c = singleton empty | otherwise = S.map (insert x) sr `union` sr where (x,rc) = deleteFindMin c sr = subconjuntos rc -- (elementosFamilia f) es el conjunto de los elementos de los elementos -- de la familia f. Por ejemplo, -- λ> elementosFamilia (fromList [empty, fromList [1,2], fromList [2,5]]) -- fromList [1,2,5] elementosFamilia :: Ord a => Set (Set a) -> Set a elementosFamilia = unions . toList -- (nOcurrencias f x) es el número de conjuntos de la familia f a los -- que pertenece el elemento x. Por ejemplo, -- nOcurrencias (fromList [empty, fromList [1,3], fromList [3,5]]) 3 == 2 -- nOcurrencias (fromList [empty, fromList [1,3], fromList [3,5]]) 4 == 0 -- nOcurrencias (fromList [empty, fromList [1,3], fromList [3,5]]) 5 == 1 nOcurrencias :: Ord a => Set (Set a) -> a -> Int nOcurrencias f x = length (L.filter (x `member`) (toList f)) mayoritarios :: Ord a => Set (Set a) -> [a] mayoritarios f = [x | x <- toList (elementosFamilia f) , nOcurrencias f x >= n] where n = (1 + size f) `div` 2 conjeturaFrankl :: Int -> Bool conjeturaFrankl n = and [ not (L.null (mayoritarios f)) | f <- fs , f /= fromList [] , f /= fromList [empty]] where fs = toList (familiasEstables (fromList [1..n])) -- conjeturaFrankl' :: Int -> Bool conjeturaFrankl' n = [f | f <- fs , L.null (mayoritarios f) , f /= fromList [] , f /= fromList [empty]] where fs = toList (familiasEstables (fromList [1..n])) |
Un número de Aquiles es un número natural n que es potente (es decir, si p es un divisor primo de n, entonces p² también lo es) y no es una potencia perfecta (es decir, no existen números naturales m y k tales que n es igual a m^k). Por ejemplo,
Los primeros números de Aquiles son
|
1 |
72, 108, 200, 288, 392, 432, 500, 648, 675, 800, 864, 968, 972, ... |
Definir las funciones
|
1 2 3 |
esAquiles :: Integer -> Bool huecosDeAquiles :: [Integer] graficaHuecosDeAquiles :: Int -> IO () |
tales que
|
1 2 3 4 5 |
esAquiles 108 == True esAquiles 360 == False esAquiles 784 == False esAquiles 5425069447 == True esAquiles 5425069448 == True |
|
1 2 |
λ> take 15 huecosDeAquiles [36,92,88,104,40,68,148,27,125,64,104,4,153,27,171] |
|
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 |
import Data.List (group) import Data.Numbers.Primes (primeFactors) import Graphics.Gnuplot.Simple -- Definición de esAquiles -- ======================= esAquiles :: Integer -> Bool esAquiles x = esPotente x && noEsPotenciaPerfecta x -- (esPotente x) se verifica si x es potente. Por ejemplo, -- esPotente 108 == True -- esPotente 360 == False -- esPotente 784 == True esPotente :: Integer -> Bool esPotente x = all (>1) (exponentes x) -- (exponentes x) es la lista de los exponentes en la factorización de -- x. Por ejemplo, -- exponentes 108 == [2,3] -- exponentes 360 == [3,2,1] -- exponentes 784 == [4,2] exponentes :: Integer -> [Int] exponentes x = map length (group (primeFactors x)) -- (noEsPotenciaPerfecta x) se verifica si x no es una potencia -- perfecta. Por ejemplo, -- noEsPotenciaPerfecta 108 == True -- noEsPotenciaPerfecta 360 == True -- noEsPotenciaPerfecta 784 == False noEsPotenciaPerfecta :: Integer -> Bool noEsPotenciaPerfecta x = foldl1 gcd (exponentes x) == 1 -- Definición de huecosDeAquiles -- ============================= huecosDeAquiles :: [Integer] huecosDeAquiles = zipWith (-) (tail aquiles) aquiles -- aquiles es la sucesión de los números de Aquiles. Por ejemplo, -- λ> take 15 aquiles -- [72,108,200,288,392,432,500,648,675,800,864,968,972,1125,1152] aquiles :: [Integer] aquiles = filter esAquiles [2..] -- Definición de graficaHuecosDeAquiles -- ==================================== graficaHuecosDeAquiles :: Int -> IO () graficaHuecosDeAquiles n = plotList [ Key Nothing , PNG "Huecos_de_Aquiles.png" ] (take n huecosDeAquiles) |
Definir las funciones
|
1 2 |
minimasDistancias :: Matrix Int -> Matrix Int sumaMinimaDistanciasIdentidad :: Int -> Int |
tales que
|
1 2 3 4 5 6 7 8 9 10 11 12 |
λ> minimasDistancias (fromLists [[0,1,1],[0,0,1]]) ( 1 0 0 ) ( 2 1 0 ) λ> minimasDistancias (fromLists [[0,0,1],[1,0,0]]) ( 1 1 0 ) ( 0 1 1 ) λ> minimasDistancias (identity 5) ( 0 1 2 3 4 ) ( 1 0 1 2 3 ) ( 2 1 0 1 2 ) ( 3 2 1 0 1 ) ( 4 3 2 1 0 ) |
|
1 2 3 4 |
sumaMinimaDistanciasIdentidad 5 == 40 sumaMinimaDistanciasIdentidad (10^2) == 333300 sumaMinimaDistanciasIdentidad (10^4) == 333333330000 sumaMinimaDistanciasIdentidad (10^6) == 333333333333000000 |
|
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 183 184 185 186 187 188 189 190 191 |
import Data.Matrix import Data.Maybe import Test.QuickCheck -- 1ª definición de minimasDistancias -- ================================== minimasDistancias :: Matrix Int -> Matrix Int minimasDistancias a = matrix (nrows a) (ncols a) (\(i,j) -> minimaDistancia (i,j) a) minimaDistancia :: (Int,Int) -> Matrix Int -> Int minimaDistancia (a,b) p = minimum [distancia (a,b) (c,d) | (c,d) <- unos p] unos :: Matrix Int -> [(Int,Int)] unos p = [(i,j) | i <- [1..nrows p] , j <- [1..ncols p] , p ! (i,j) == 1] distancia :: (Int,Int) -> (Int,Int) -> Int distancia (a,b) (c,d) = abs (c - a) + abs (d - b) -- 2ª definición de minimasDistancias -- ================================== minimasDistancias2 :: Matrix Int -> Matrix Int minimasDistancias2 a = fmap fromJust (aux (matrizInicial a)) where aux b | Nothing `elem` c = aux c | otherwise = c where c = propagacion b -- (matrizInicial a) es la matriz que tiene (Just 0) en los elementos de -- a iguales a 1 y Nothing en los restantes. Por ejemplo, -- λ> matrizInicial (fromLists [[0,0,1],[1,0,0]]) -- ( Nothing Nothing Just 0 ) -- ( Just 0 Nothing Nothing ) matrizInicial :: Matrix Int -> Matrix (Maybe Int) matrizInicial a = matrix m n f where m = nrows a n = ncols a f (i,j) | a ! (i,j) == 1 = Just 0 | otherwise = Nothing -- (propagacion a) es la matriz obtenida cambiando los elementos Nothing -- de a por el siguiente del mínimo de los valores de sus vecinos. Por -- ejemplo, -- λ> propagacion (fromLists [[0,1,1],[0,0,1]]) -- ( Just 1 Just 0 Just 0 ) -- ( Nothing Just 1 Just 0 ) -- -- λ> propagacion it -- ( Just 1 Just 0 Just 0 ) -- ( Just 2 Just 1 Just 0 ) propagacion :: Matrix (Maybe Int) -> Matrix (Maybe Int) propagacion a = matrix m n f where m = nrows a n = ncols a f (i,j) | isJust x = x | otherwise = siguiente (minimo (valoresVecinos a (i,j))) where x = a ! (i,j) -- (valoresVecinos a p) es la lista de los valores de los vecinos la -- posición p en la matriz a. Por ejemplo, -- λ> a = fromList 3 4 [1..] -- λ> a -- ( 1 2 3 4 ) -- ( 5 6 7 8 ) -- ( 9 10 11 12 ) -- -- λ> valoresVecinos a (1,1) -- [5,2] -- λ> valoresVecinos a (2,3) -- [3,11,6,8] -- λ> valoresVecinos a (2,4) -- [4,12,7] valoresVecinos :: Matrix a -> (Int,Int) -> [a] valoresVecinos a (i,j) = [a ! (k,l) | (k,l) <- vecinos m n (i,j)] where m = nrows a n = ncols a -- (vecinos m n p) es la lista de las posiciones vecinas de la posición -- p en la matriz a; es decir, los que se encuentran a su izquierda, -- derecha, arriba o abajo. por ejemplo, -- vecinos 3 4 (1,1) == [(2,1),(1,2)] -- vecinos 3 4 (2,3) == [(1,3),(3,3),(2,2),(2,4)] -- vecinos 3 4 (2,4) == [(1,4),(3,4),(2,3)] vecinos :: Int -> Int -> (Int,Int) -> [(Int,Int)] vecinos m n (i,j) = [(i - 1,j) | i > 1] ++ [(i + 1,j) | i < m] ++ [(i, j - 1) | j > 1] ++ [(i, j + 1) | j < n] -- (minimo xs) es el mínimo de la lista de valores opcionales xs -- (considerando Nothing como el mayor elemento). Por ejemplo, -- minimo [Just 3, Nothing, Just 2] == Just 2 minimo :: [Maybe Int] -> Maybe Int minimo = foldr1 minimo2 -- (minimo2 x y) es el mínimo de los valores opcionales x e y -- (considerando Nothing como el mayor elemento). Por ejemplo, -- minimo2 (Just 3) (Just 2) == Just 2 -- minimo2 (Just 1) (Just 2) == Just 1 -- minimo2 (Just 1) Nothing == Just 1 -- minimo2 Nothing (Just 2) == Just 2 -- minimo2 Nothing Nothing == Nothing minimo2 :: Maybe Int -> Maybe Int -> Maybe Int minimo2 (Just x) (Just y) = Just (min x y) minimo2 Nothing (Just y) = Just y minimo2 (Just x) Nothing = Just x minimo2 Nothing Nothing = Nothing -- (siguiente x) es el siguiente elemento del opcional x (considerando -- Nothing como el infinito). Por ejemplo, -- siguiente (Just 3) == Just 4 -- siguiente Nothing == Nothing siguiente :: Maybe Int -> Maybe Int siguiente (Just x) = Just (1 + x) siguiente Nothing = Nothing -- Comparación de eficiencia -- ========================= -- La comparación es -- λ> maximum (minimasDistancias (identity 40)) -- 39 -- (3.85 secs, 654,473,496 bytes) -- λ> maximum (minimasDistancias2 (identity 40)) -- 39 -- (0.50 secs, 75,079,912 bytes) -- 1ª definición de sumaMinimaDistanciasIdentidad -- ============================================== sumaMinimaDistanciasIdentidad :: Int -> Int sumaMinimaDistanciasIdentidad n = sum (minimasDistancias (identity n)) -- 2ª definición de sumaMinimaDistanciasIdentidad -- ============================================== sumaMinimaDistanciasIdentidad2 :: Int -> Int sumaMinimaDistanciasIdentidad2 n = n*(n^2-1) `div` 3 -- Equivalencia de las definiciones de sumaMinimaDistanciasIdentidad -- ================================================================= -- La propiedad es prop_MinimaDistanciasIdentidad :: Positive Int -> Bool prop_MinimaDistanciasIdentidad (Positive n) = sumaMinimaDistanciasIdentidad n == sumaMinimaDistanciasIdentidad2 n -- La comprobación es -- λ> quickCheckWith (stdArgs {maxSize=50}) prop_MinimaDistanciasIdentidad -- +++ OK, passed 100 tests. -- Comparación de eficiencia de sumaMinimaDistanciasIdentidad -- ========================================================== -- La comparación es -- λ> sumaMinimaDistanciasIdentidad 50 -- 41650 -- (0.24 secs, 149,395,744 bytes) -- λ> sumaMinimaDistanciasIdentidad 100 -- 333300 -- (1.98 secs, 1,294,676,272 bytes) -- λ> sumaMinimaDistanciasIdentidad 200 -- 2666600 -- (17.96 secs, 11,094,515,016 bytes) -- -- λ> sumaMinimaDistanciasIdentidad2 50 -- 41650 -- (0.00 secs, 126,944 bytes) -- λ> sumaMinimaDistanciasIdentidad2 100 -- 333300 -- (0.00 secs, 126,872 bytes) -- λ> sumaMinimaDistanciasIdentidad2 200 -- 2666600 -- (0.00 secs, 131,240 bytes) -- -- Resumidamente, el tiempo es -- -- +-----+---------+--------+ -- | n | 1ª def. | 2ª def | -- +-----+---------+--------+ -- | 50 | 0.24 | 0.00 | -- | 100 | 1.98 | 0.00 | -- | 200 | 17.96 | 0.00 | -- +-----+---------+--------+ |
Definir la función
|
1 |
tieneCombinacionDivisible :: [Int] -> Int -> Bool |
tal que (tieneCombinacionDivisible xs m) se verifica si existe alguna forma de combinar todos los elementos de la lista (con las operaciones suma o resta) de forma que el resultado sea divisible por m. Por ejemplo,
|
1 2 |
tieneCombinacionDivisible [1,3,4,6] 4 == True tieneCombinacionDivisible [1,3,9] 2 == False |
En el primer ejemplo, 1 – 2 + 3 + 4 + 6 = 12 es una combinación divisible por 4. En el segundo ejemplo, las combinaciones de [1,3,9] son
|
1 2 3 4 5 6 7 8 |
1 + 3 + 9 = 13 -1 + 3 + 9 = 11 1 - 3 + 9 = 7 -1 - 3 + 9 = 5 1 + 3 - 9 = -5 -1 + 3 - 9 = -7 1 - 3 - 9 = -11 -1 - 3 - 9 = -13 |
y ninguna de las 4 es divisible por 2.
|
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 |
import Test.QuickCheck -- 1ª solución -- =========== tieneCombinacionDivisible :: [Int] -> Int -> Bool tieneCombinacionDivisible xs m = any esDivisible (valoresCombinaciones xs) where esDivisible x = x `mod` m == 0 -- (valoresCombinaciones xs) es la lista de los valores de todas las -- combinaciones de todos los elementos de la lista con las operaciones -- suma o resta. Por ejemplo, -- λ> valoresCombinaciones [1,3,4,6] -- [14,12,8,6,6,4,0,-2,2,0,-4,-6,-6,-8,-12,-14] -- λ> valoresCombinaciones [1,3,-4,6] -- [6,4,0,-2,14,12,8,6,-6,-8,-12,-14,2,0,-4,-6] valoresCombinaciones :: [Int] -> [Int] valoresCombinaciones [] = [] valoresCombinaciones [x] = [x,-x] valoresCombinaciones (x:xs) = concat [[y + x, y - x] | y <- ys] where ys = valoresCombinaciones xs -- 2ª solución -- =========== tieneCombinacionDivisible2 :: [Int] -> Int -> Bool tieneCombinacionDivisible2 xs m = tieneCombinacionCongruente xs m 0 -- (tieneCombinacionCongruente xs m a) se verifica si existe alguna -- forma de combinar todos los elementos de la lista xs (con las -- operaciones suma o resta) de forma que el resultado sea congruente -- con a módulo m. Por ejemplo, -- tieneCombinacionCongruente [1,3,4,6] 4 0 == True -- tieneCombinacionCongruente [1,3,4,6] 4 1 == False -- tieneCombinacionCongruente [1,3,9] 2 0 == False -- tieneCombinacionCongruente [1,3,9] 2 1 == True tieneCombinacionCongruente :: [Int] -> Int -> Int -> Bool tieneCombinacionCongruente [] _ _ = False tieneCombinacionCongruente [x] m a = (x - a) `mod` m == 0 tieneCombinacionCongruente (x:xs) m a = tieneCombinacionCongruente xs m (a-x) || tieneCombinacionCongruente xs m (a+x) -- Equivalencia -- ============ -- La propiedad es prop_tieneCombinacionDivisible :: [Int] -> Positive Int -> Bool prop_tieneCombinacionDivisible xs (Positive m) = tieneCombinacionDivisible xs m == tieneCombinacionDivisible2 xs m -- La comprobación es -- λ> quickCheckWith (stdArgs {maxSize=25}) prop_tieneCombinacionDivisible -- +++ OK, passed 100 tests. -- Comparación de eficiencia -- ========================= -- λ> (n,xs,m) = (200,[-n..n],sum [1..n]) -- (0.00 secs, 0 bytes) -- λ> and [tieneCombinacionDivisible xs a | a <- [1..m]] -- True -- (4.74 secs, 6,536,494,976 bytes) -- λ> and [tieneCombinacionDivisible2 xs a | a <- [1..m]] -- True -- (2.97 secs, 3,381,932,664 bytes) |
Los segmentos iniciales de [3,1,2,5] son [3], [3,1], [3,1,2] y [3,1,2,5]. Sus sumas son 3, 4, 6 y 9, respectivamente. La suma de dichas sumas es 24.
Definir la función
|
1 |
sumaSegmentosIniciales :: [Integer] -> Integer |
tal que (sumaSegmentosIniciales xs) es la suma de las sumas de los segmentos iniciales de xs. Por ejemplo,
|
1 2 |
sumaSegmentosIniciales [3,1,2,5] == 24 sumaSegmentosIniciales [1..3*10^6] == 4500004500001000000 |
Comprobar con QuickCheck que la suma de las sumas de los segmentos iniciales de la lista formada por n veces el número uno es el n-ésimo número triangular; es decir que
|
1 |
sumaSegmentosIniciales (genericReplicate n 1) |
es igual a
|
1 |
n * (n + 1) `div` 2 |
|
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 |
import Data.List (genericLength, genericReplicate) import Test.QuickCheck -- 1ª solución -- =========== sumaSegmentosIniciales :: [Integer] -> Integer sumaSegmentosIniciales xs = sum [sum (take k xs) | k <- [1.. length xs]] -- 2ª solución -- =========== sumaSegmentosIniciales2 :: [Integer] -> Integer sumaSegmentosIniciales2 xs = sum (zipWith (*) [n,n-1..1] xs) where n = genericLength xs -- 3ª solución -- =========== sumaSegmentosIniciales3 :: [Integer] -> Integer sumaSegmentosIniciales3 xs = sum (scanl1 (+) xs) -- Comprobación de la equivalencia -- =============================== -- La propiedad es prop_sumaSegmentosInicialesEquiv :: [Integer] -> Bool prop_sumaSegmentosInicialesEquiv xs = all (== sumaSegmentosIniciales xs) [f xs | f <- [ sumaSegmentosIniciales2 , sumaSegmentosIniciales3]] -- La comprobación es -- λ> quickCheck prop_sumaSegmentosInicialesEquiv -- +++ OK, passed 100 tests. -- Comparación de eficiencia -- ========================= -- λ> sumaSegmentosIniciales [1..10^4] -- 166716670000 -- (2.42 secs, 7,377,926,824 bytes) -- λ> sumaSegmentosIniciales2 [1..10^4] -- 166716670000 -- (0.01 secs, 4,855,176 bytes) -- -- λ> sumaSegmentosIniciales2 [1..3*10^6] -- 4500004500001000000 -- (2.68 secs, 1,424,404,168 bytes) -- λ> sumaSegmentosIniciales3 [1..3*10^6] -- 4500004500001000000 -- (1.54 secs, 943,500,384 bytes) -- Comprobación de la propiedad -- ============================ -- La propiedad es prop_sumaSegmentosIniciales :: Positive Integer -> Bool prop_sumaSegmentosIniciales (Positive n) = sumaSegmentosIniciales3 (genericReplicate n 1) == n * (n + 1) `div` 2 -- La compronación es -- λ> quickCheck prop_sumaSegmentosIniciales -- +++ OK, passed 100 tests. |
Los árboles se pueden representar mediante el siguiente tipo de datos
|
1 2 |
data Arbol = N Int [Arbol] deriving Show |
Por ejemplo, los árboles
|
1 2 3 4 5 6 |
1 1 1 / \ / \ / \ / \ 8 3 8 3 2 6 /|\ /|\ | / \ / \ 4 2 6 4 5 6 2 4 5 5 7 |
se representan por
|
1 2 3 4 |
ej1, ej2, ej3 :: Arbol ej1 = N 1 [N 2 [N 4 [], N 5 []], N 6 [N 5 [], N 7 []]] ej2 = N 1 [N 8 [], N 3 [N 4 [], N 2 [], N 6 []]] ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 2 []]] |
Definir la función
|
1 |
hojasEnNoDecreciente :: Arbol -> [Int] |
tal que (hojasEnNoDecreciente a) es el conjunto de las hojas de a que se encuentran en alguna rama no decreciente. Por ejemplo,
|
1 2 3 |
hojasEnNoDecreciente ej1 == [4,5,7] hojasEnNoDecreciente ej2 == [4,6,8] hojasEnNoDecreciente ej3 == [] |
|
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 |
import Data.List (sort, nub) data Arbol = N Int [Arbol] deriving Show ej1, ej2, ej3 :: Arbol ej1 = N 1 [N 2 [N 4 [], N 5 []], N 6 [N 5 [], N 7 []]] ej2 = N 1 [N 8 [], N 3 [N 4 [], N 2 [], N 6 []]] ej3 = N 1 [N 8 [N 4 [], N 5 [], N 6 []], N 3 [N 2 []]] -- 1ª solución -- =========== hojasEnNoDecreciente :: Arbol -> [Int] hojasEnNoDecreciente a = sort (nub (map last (ramasNoDecrecientes a))) -- ramasNoDecrecientes ej1 == [[1,2,4],[1,2,5],[1,6,7]] -- ramasNoDecrecientes ej2 == [[1,8],[1,3,4],[1,3,6]] -- ramasNoDecrecientes ej3 == [] ramasNoDecrecientes :: Arbol -> [[Int]] ramasNoDecrecientes a = filter esNoDecreciente (ramas a) -- (ramas a) es la lista de las ramas del árbol a. Por ejemplo, -- λ> ramas ej1 -- [[1,2,4],[1,2,5],[1,6,5],[1,6,7]] -- λ> ramas ej2 -- [[1,8],[1,3,4],[1,3,2],[1,3,6]] -- λ> ramas ej3 -- [[1,8,4],[1,8,5],[1,8,6],[1,3,2]] ramas :: Arbol -> [[Int]] ramas (N x []) = [[x]] ramas (N x as) = map (x:) (concatMap ramas as) -- (esNoDecreciente xs) se verifica si la lista xs es no -- decreciente. Por ejemplo, -- esNoDecreciente [1,3,3,5] == True -- esNoDecreciente [1,3,5,3] == False esNoDecreciente :: [Int] -> Bool esNoDecreciente xs = and (zipWith (<=) xs (tail xs)) -- 2ª solución -- =========== -- hojasEnNoDecreciente ej1 == [4,5,7] -- hojasEnNoDecreciente ej2 == [4,6,8] -- hojasEnNoDecreciente ej3 == [] hojasEnNoDecreciente2 :: Arbol -> [Int] hojasEnNoDecreciente2 = sort . nub . aux where aux (N x []) = [x] aux (N x as) = concat [aux (N y bs) | (N y bs) <- as, x <= y] |
Las matrices de Hadamard se definen recursivamente como sigue
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 |
λ> hadamard 0 ( 1 ) λ> hadamard 1 ( 1 1 ) ( 1 -1 ) λ> hadamard 2 ( 1 1 1 1 ) ( 1 -1 1 -1 ) ( 1 1 -1 -1 ) ( 1 -1 -1 1 ) λ> hadamard 3 ( 1 1 1 1 1 1 1 1 ) ( 1 -1 1 -1 1 -1 1 -1 ) ( 1 1 -1 -1 1 1 -1 -1 ) ( 1 -1 -1 1 1 -1 -1 1 ) ( 1 1 1 1 -1 -1 -1 -1 ) ( 1 -1 1 -1 -1 1 -1 1 ) ( 1 1 -1 -1 -1 -1 1 1 ) ( 1 -1 -1 1 -1 1 1 -1 ) |
En general, la n-ésima matriz de Hadamard, H(n), es
|
1 2 |
( H(n-1) H(n-1) ) ( H(n-1) -H(n-1) ) |
Definir la función
|
1 |
hadamard :: Int -> Matrix Int |
tal que (hadamard n) es la n-ésima matriz de Hadamard.
Comprobar con QuickCheck que para todo número natural n, el producto de la n-ésima matriz de Hadamard y su traspuesta es igual al producto de 2^n por la matriz identidad de orden 2^n.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 |
import Data.Matrix (Matrix, identity, joinBlocks, scaleMatrix, transpose) import Test.QuickCheck hadamard :: Int -> Matrix Int hadamard 0 = identity 1 hadamard n = joinBlocks (a, a, a, b) where a = hadamard (n-1) b = scaleMatrix (-1) a -- La propiedad es prop_Hadamard :: (Positive Int) -> Bool prop_Hadamard (Positive n) = h * transpose h == scaleMatrix (2^n) (identity (2^n)) where h = hadamard n -- La comprobación es -- λ> quickCheckWith (stdArgs {maxSize=7}) prop_Hadamard -- +++ OK, passed 100 tests. |
Definir la función
|
1 |
menorNoSuma :: [Integer] -> Integer |
tal que (menorNoSuma xs) es el menor número que no se puede escribir como suma de un subconjunto de xs, donde se supone que xs es un conjunto de números enteros positivos. Por ejemplo,
|
1 2 3 4 5 |
menorNoSuma [6,1,2] == 4 menorNoSuma [1,2,3,9] == 7 menorNoSuma [5] == 1 menorNoSuma [1..20] == 211 menorNoSuma [1..10^6] == 500000500001 |
Comprobar con QuickCheck que para todo n,
|
1 |
menorNoSuma [1..n] == 1 + sum [1..n] |
|
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 |
-- 1ª definición -- ============= import Data.List (sort, subsequences) import Test.QuickCheck menorNoSuma1 :: [Integer] -> Integer menorNoSuma1 xs = head [n | n <- [1..], n `notElem` sumas xs] -- (sumas xs) es la lista de las sumas de los subconjuntos de xs. Por ejemplo, -- sumas [1,2,6] == [0,1,2,3,6,7,8,9] -- sumas [6,1,2] == [0,6,1,7,2,8,3,9] sumas :: [Integer] -> [Integer] sumas xs = map sum (subsequences xs) -- 2ª definición -- ============= menorNoSuma2 :: [Integer] -> Integer menorNoSuma2 = menorNoSumaOrd . reverse . sort -- (menorNoSumaOrd xs) es el menor número que no se puede escribir como -- suma de un subconjunto de xs, donde xs es una lista de números -- naturales ordenada de mayor a menor. Por ejemplo, -- menorNoSumaOrd [6,2,1] == 4 menorNoSumaOrd [] = 1 menorNoSumaOrd (x:xs) | x > y = y | otherwise = y+x where y = menorNoSumaOrd xs -- Comparación de eficiencia -- ========================= -- λ> menorNoSuma1 [1..20] -- 211 -- (20.40 secs, 28,268,746,320 bytes) -- λ> menorNoSuma2 [1..20] -- 211 -- (0.01 secs, 0 bytes) -- Propiedad -- ========= -- La propiedad es prop_menorNoSuma :: (Positive Integer) -> Bool prop_menorNoSuma (Positive n) = menorNoSuma2 [1..n] == 1 + sum [1..n] -- La comprobación es -- λ> quickCheckWith (stdArgs {maxSize=7}) prop_menorNoSuma -- +++ OK, passed 100 tests. |
El orden de divisibilidad de un número x es el mayor n tal que para todo i menor o igual que n, los i primeros dígitos de n es divisible por i. Por ejemplo, el orden de divisibilidad de 74156 es 3 porque
|
1 2 3 4 |
7 es divisible por 1 74 es divisible por 2 741 es divisible por 3 7415 no es divisible por 4 |
Definir la función
|
1 |
ordenDeDivisibilidad :: Integer -> Int |
tal que (ordenDeDivisibilidad x) es el orden de divisibilidad de x. Por ejemplo,
|
1 2 3 4 |
ordenDeDivisibilidad 74156 == 3 ordenDeDivisibilidad 12 == 2 ordenDeDivisibilidad 7 == 1 ordenDeDivisibilidad 3608528850368400786036725 == 25 |
|
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 |
import Data.List (inits) -- 1ª definición de ordenDeDivisibilidad -- ===================================== ordenDeDivisibilidad :: Integer -> Int ordenDeDivisibilidad n = length (takeWhile (\(x,k) -> x `mod` k == 0) (zip (sucDigitos n) [1..])) -- (sucDigitos x) es la sucesión de los dígitos de x. Por ejemplo, -- sucDigitos 325 == [3,32,325] -- sucDigitos 32050 == [3,32,320,3205,32050] sucDigitos :: Integer -> [Integer] sucDigitos n = [n `div` (10^i) | i <- [k-1,k-2..0]] where k = length (show n) -- 2ª definición de sucDigitos sucDigitos2 :: Integer -> [Integer] sucDigitos2 n = [read xs | xs <- aux (show n)] where aux [] = [] aux (d:ds) = [d] : map (d:) (aux ds) -- 3ª definición de sucDigitos sucDigitos3 :: Integer -> [Integer] sucDigitos3 n = [read (take k ds) | k <- [1..length ds]] where ds = show n -- 4ª definición de sucDigitos sucDigitos4 :: Integer -> [Integer] sucDigitos4 n = [read xs | xs <- tail (inits (show n))] -- 5ª definición de sucDigitos sucDigitos5 :: Integer -> [Integer] sucDigitos5 n = map read (tail (inits (show n))) -- 6ª definición de sucDigitos sucDigitos6 :: Integer -> [Integer] sucDigitos6 = map read . (tail . inits . show) -- Eficiencia de las definiciones de sucDigitos -- ghci> length (sucDigitos (10^5000)) -- 5001 -- (0.01 secs, 1550688 bytes) -- ghci> length (sucDigitos2 (10^5000)) -- 5001 -- (1.25 secs, 729411872 bytes) -- ghci> length (sucDigitos3 (10^5000)) -- 5001 -- (0.02 secs, 2265120 bytes) -- ghci> length (sucDigitos4 (10^5000)) -- 5001 -- (1.10 secs, 728366872 bytes) -- ghci> length (sucDigitos5 (10^5000)) -- 5001 -- (1.12 secs, 728393864 bytes) -- ghci> length (sucDigitos6 (10^5000)) -- 5001 -- (1.20 secs, 728403052 bytes) -- -- ghci> length (sucDigitos (10^3000000)) -- 3000001 -- (2.73 secs, 820042696 bytes) -- ghci> length (sucDigitos3 (10^3000000)) -- 3000001 -- (3.69 secs, 820043688 bytes) -- 2ª definición de ordenDeDivisibilidad -- ===================================== ordenDeDivisibilidad2 :: Integer -> Int ordenDeDivisibilidad2 x = length $ takeWhile (==0) $ zipWith (mod . read) (tail $ inits $ show x) [1..] |
En 1999, L.J. Lange publicó el artículo An elegant new continued fraction for π.
En el primer teorema del artículo se demuestra la siguiente expresión de π mediante una fracción continua
La primeras aproximaciones son
|
1 2 3 |
a(1) = 3+1 = 4.0 a(2) = 3+(1/(6+9)) = 3.066666666666667 a(3) = 3+(1/(6+9/(6+25))) = 3.158974358974359 |
Definir las funciones
|
1 2 |
aproximacionPi :: Int -> Double grafica :: [Int] -> IO () |
tales que
|
1 2 3 4 5 6 |
aproximacionPi 1 == 4.0 aproximacionPi 2 == 3.066666666666667 aproximacionPi 3 == 3.158974358974359 aproximacionPi 10 == 3.141287132741557 aproximacionPi 100 == 3.141592398533554 aproximacionPi 1000 == 3.1415926533392926 |
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 |
import Graphics.Gnuplot.Simple -- fraccionPi es la representación de la fracción continua de pi como un -- par de listas infinitas. fraccionPi :: [(Integer, Integer)] fraccionPi = zip (3 : [6,6..]) (map (^2) [1,3..]) -- (aproximacionFC n fc) es la n-ésima aproximación de la fracción -- continua fc (como un par de listas). aproximacionFC :: Int -> [(Integer, Integer)] -> Double aproximacionFC n = foldr (\(a,b) z -> fromIntegral a + fromIntegral b / z) 1 . take n aproximacionPi :: Int -> Double aproximacionPi n = aproximacionFC n fraccionPi grafica :: [Int] -> IO () grafica xs = plotList [Key Nothing] [(k,aproximacionPi k) | k <- xs] |
En el artículo El desarrollo más bello de Pi como suma infinita, Miguel Ángel Morales comenta el desarrollo de pi publicado por Leonhard Euler en su libro «Introductio in Analysis Infinitorum» (1748).
El desarrollo es el siguiente
y se obtiene a partir de la serie armónica
modificando sólo el signo de algunos términos según el siguiente criterio:
Por ejemplo,
Definir las funciones
|
1 2 |
aproximacionPi :: Int -> Double grafica :: Int -> IO () |
tales que
|
1 2 3 4 5 6 7 |
aproximacionPi 1 == 1.0 aproximacionPi 10 == 2.3289682539682537 aproximacionPi 100 == 2.934318000847734 aproximacionPi 1000 == 3.0603246224585128 aproximacionPi 10000 == 3.1105295744825403 aproximacionPi 100000 == 3.134308801935256 aproximacionPi 1000000 == 3.1395057903490806 |
|
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 |
import Data.Numbers.Primes import Graphics.Gnuplot.Simple -- 1ª definición -- ============= aproximacionPi :: Int -> Double aproximacionPi n = sum [1 / fromIntegral (k * signo k) | k <- [1..n]] signoPrimo :: Int -> Int signoPrimo 2 = 1 signoPrimo p | p `mod` 4 == 3 = 1 | otherwise = -1 signo :: Int -> Int signo n | isPrime n = signoPrimo n | otherwise = product (map signoPrimo (primeFactors n)) -- 2ª definición -- ============= aproximacionPi2 :: Int -> Double aproximacionPi2 n = serieEuler !! (n-1) serieEuler :: [Double] serieEuler = scanl1 (+) [1 / fromIntegral (n * signo n) | n <- [1..]] -- Definición de grafica -- ===================== grafica :: Int -> IO () grafica n = plotList [Key Nothing] [(k,aproximacionPi2 k) | k <- [100,110..n]] |
Se pueden generar los dígitos de Pi, como se explica en el artículo Unbounded spigot algorithms for the digits of pi c0on la función digitosPi definida por
|
1 2 3 4 5 6 |
digitosPi :: [Integer] digitosPi = g(1,0,1,1,3,3) where g (q,r,t,k,n,l) = if 4*q+r-t < n*t then n : g (10*q, 10*(r-n*t), t, k, div (10*(3*q+r)) t - 10*n, l) else g (q*k, (2*q+r)*l, t*l, k+1, div (q*(7*k+2)+r*l) (t*l), l+2) |
Por ejemplo,
|
1 2 |
λ> take 25 digitosPi [3,1,4,1,5,9,2,6,5,3,5,8,9,7,9,3,2,3,8,4,6,2,6,4,3] |
La distribución de los primeros 25 dígitos de pi es [0,2,3,5,3,3,3,1,2,3] ya que el 0 no aparece, el 1 ocurre 2 veces, el 3 ocurre 3 veces, el 4 ocurre 5 veces, …
Usando digitosPi, definir las siguientes funciones
|
1 2 |
distribucionDigitosPi :: Int -> [Int] frecuenciaDigitosPi :: Int -> [Double] |
tales que
|
1 2 3 4 5 6 7 8 |
λ> distribucionDigitosPi 10 [0,2,1,2,1,2,1,0,0,1] λ> distribucionDigitosPi 100 [8,8,12,12,10,8,9,8,12,13] λ> distribucionDigitosPi 1000 [93,116,103,103,93,97,94,95,101,105] λ> distribucionDigitosPi 5000 [466,531,496,460,508,525,513,488,492,521] |
|
1 2 3 4 5 6 7 8 |
λ> frecuenciaDigitosPi 10 [0.0,20.0,10.0,20.0,10.0,20.0,10.0,0.0,0.0,10.0] λ> frecuenciaDigitosPi 100 [8.0,8.0,12.0,12.0,10.0,8.0,9.0,8.0,12.0,13.0] λ> frecuenciaDigitosPi 1000 [9.3,11.6,10.3,10.3,9.3,9.7,9.4,9.5,10.1,10.5] λ> frecuenciaDigitosPi 5000 [9.32,10.62,9.92,9.2,10.16,10.5,10.26,9.76,9.84,10.42] |
|
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 |
import Data.Array import Data.List (group, sort) digitosPi :: [Integer] digitosPi = g(1,0,1,1,3,3) where g (q,r,t,k,n,l) = if 4*q+r-t < n*t then n : g (10*q, 10*(r-n*t), t, k, div (10*(3*q+r)) t - 10*n, l) else g (q*k, (2*q+r)*l, t*l, k+1, div (q*(7*k+2)+r*l) (t*l), l+2) -- 1ª definición -- ============= distribucionDigitosPi :: Int -> [Int] distribucionDigitosPi n = elems (accumArray (+) 0 (0,9) [ (i,1) | i <- take n digitosPi]) frecuenciaDigitosPi :: Int -> [Double] frecuenciaDigitosPi n = [100 * (fromIntegral x / m) | x <- distribucionDigitosPi n] where m = fromIntegral n -- 2ª definición -- ============= distribucionDigitosPi2 :: Int -> [Int] distribucionDigitosPi2 n = [length xs - 1 | xs <- group (sort (take n digitosPi ++ [0..9]))] frecuenciaDigitosPi2 :: Int -> [Double] frecuenciaDigitosPi2 n = [100 * (fromIntegral x / m) | x <- distribucionDigitosPi2 n] where m = fromIntegral n -- Comparación de eficiencia -- ========================= -- λ> last (take 5000 digitosPi) -- 2 -- (4.47 secs, 3,927,848,448 bytes) -- λ> frecuenciaDigitosPi 5000 -- [9.32,10.62,9.92,9.2,10.16,10.5,10.26,9.76,9.84,10.42] -- (0.01 secs, 0 bytes) -- λ> frecuenciaDigitosPi2 5000 -- [9.32,10.62,9.92,9.2,10.16,10.5,10.26,9.76,9.84,10.42] -- (0.02 secs, 0 bytes) |
La fórmula de Gregory-Leibniz para calcular pi es
y la de Beeler es
Definir las funciones
|
1 2 3 |
aproximaPiGL :: Int -> Double aproximaPiBeeler :: Int -> Double graficas :: [Int] -> IO () |
tales que
|
1 2 3 4 5 6 7 8 |
aproximaPiGL 1 == 4.0 aproximaPiGL 2 == 2.666666666666667 aproximaPiGL 3 == 3.466666666666667 aproximaPiGL 10 == 3.0418396189294032 aproximaPiGL 100 == 3.1315929035585537 aproximaPiGL 1000 == 3.140592653839794 aproximaPiGL 10000 == 3.1414926535900345 aproximaPiGL 100000 == 3.1415826535897198 |
|
1 2 3 4 5 6 |
aproximaPiBeeler 1 == 2.0 aproximaPiBeeler 2 == 2.6666666666666665 aproximaPiBeeler 3 == 2.933333333333333 aproximaPiBeeler 10 == 3.140578169680337 aproximaPiBeeler 60 == 3.141592653589793 pi == 3.141592653589793 |
|
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 |
import Graphics.Gnuplot.Simple -- Definiciones de aproximaPiGL -- ============================ -- 1ª definición de aproximaPiGL aproximaPiGL :: Int -> Double aproximaPiGL n = 4 * (sum . take n . sumaA . zipWith (/) [1,1..]) [1,3..] where sumaA (x:y:xs) = x:(-y):sumaA xs -- 2ª definición de aproximaPiGL aproximaPiGL2 :: Int -> Double aproximaPiGL2 n = 4 * (sum (take n (zipWith (/) (cycle [1,-1]) [1,3..]))) -- 3ª definición de aproximaPiGL aproximaPiGL3 :: Int -> Double aproximaPiGL3 n = 4 * (sum . take n . zipWith (/) (cycle [1,-1])) [1,3..] -- 4ª definición de aproximaPiGL aproximaPiGL4 :: Int -> Double aproximaPiGL4 n = serieGL !! (n-1) serieGL :: [Double] serieGL = scanl1 (+) (zipWith (/) numeradores denominadores) where numeradores = cycle [4,-4] denominadores = [1,3..] -- Definición de aproximaPiBeeler aproximaPiBeeler :: Int -> Double aproximaPiBeeler n = 2 * aux (fromIntegral n) 1 where aux :: Double -> Double -> Double aux n k | n == k = 1 | otherwise = 1 + (k/(2*k+1)) * aux n (1+k) -- Definición de graficas graficas :: [Int] -> IO () graficas xs = plotLists [Key Nothing] [[(k,aproximaPiGL k) | k <- xs], [(k,aproximaPiBeeler k) | k <- xs]] |
El producto de Wallis es una expresión, descubierta por John Wallis en 1655, para representar el valor de π y que establece que:
|
1 2 3 |
π 2 2 4 4 6 6 8 8 --- = --- · --- · --- · --- · --- · --- · --- · --- ··· 2 1 3 3 5 5 7 7 9 |
Definir las funciones
|
1 2 3 4 |
factoresWallis :: [Rational] productosWallis :: [Rational] aproximacionPi :: Int -> Double errorPi :: Double -> Int |
tales que
|
1 2 |
λ> take 10 factoresWallis [2 % 1,2 % 3,4 % 3,4 % 5,6 % 5,6 % 7,8 % 7,8 % 9,10 % 9,10 % 11] |
|
1 2 |
λ> take 7 productosWallis [2 % 1,4 % 3,16 % 9,64 % 45,128 % 75,256 % 175,2048 % 1225] |
|
1 2 3 4 |
aproximacionPi 20 == 3.2137849402931895 aproximacionPi 200 == 3.1493784731686008 aproximacionPi 2000 == 3.142377365093878 aproximacionPi 20000 == 3.141671186534396 |
|
1 2 3 4 |
errorPi 0.1 == 14 errorPi 0.01 == 155 errorPi 0.001 == 1569 errorPi 0.0001 == 15707 |
|
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 |
import Data.Ratio factoresWallis :: [Rational] factoresWallis = concat [[y%(y-1), y%(y+1)] | x <- [1..], let y = 2*x] productosWallis :: [Rational] productosWallis = scanl1 (*) factoresWallis aproximacionPi :: Int -> Double aproximacionPi n = fromRational (2 * productosWallis !! n) errorPi :: Double -> Int errorPi x = head [n | n <- [1..] , abs (pi - aproximacionPi n) < x] -- 2ª definición de errorPi errorPi2 :: Double -> Int errorPi2 x = length (takeWhile (>=x) [abs (pi - 2 * fromRational y) | y <- productosWallis]) -- 2ª definición de aproximacionPi aproximacionPi2 :: Int -> Double aproximacionPi2 n = 2 * productosWallis2 !! n productosWallis2 :: [Double] productosWallis2 = scanl1 (*) factoresWallis2 factoresWallis2 :: [Double] factoresWallis2 = concat [[y/(y-1), y/(y+1)] | x <- [1..], let y = 2*x] -- 3ª definición de errorPi errorPi3 :: Double -> Int errorPi3 x = head [n | n <- [1..] , abs (pi - aproximacionPi2 n) < x] -- Comparación de eficiencia -- λ> errorPi 0.001 -- 1569 -- (0.82 secs, 374,495,816 bytes) -- -- λ> errorPi2 0.001 -- 1569 -- (0.79 secs, 369,282,320 bytes) -- -- λ> errorPi3 0.001 -- 1569 -- (0.04 secs, 0 bytes) |
«¿Por qué son hermosos los números? Es como preguntar por qué es bella la Novena Sinfonía de Beethoven. Si no ves por qué, alguien no puede decírtelo. Yo sé que los números son hermosos. Si no son hermosos, nada lo es.»
Definir la función
|
1 |
productos :: Integer -> Integer -> [[Integer]] |
tal que (productos n x) es las listas de n elementos consecutivos cuyo producto es x. Por ejemplo,
|
1 2 3 4 |
productos 2 6 == [[2,3]] productos 3 6 == [[1,2,3]] productos 4 1680 == [[5,6,7,8]] productos 2 5 == [] |
Comprobar con QuickCheck que si n > 0 y x > 0, entonces
|
1 |
productos n (product [x..x+n-1]) == [[x..x+n-1]] |
Usando productos, definir la función
|
1 |
productosDe2y3consecutivos :: [Integer] |
cuyos elementos son los números naturales (no nulos) que pueden expresarse simultáneamente como producto de dos y tres números consecutivos. Por ejemplo,
|
1 |
head productosDe2y3consecutivos == 6 |
Nota. Según demostró Mordell en 1962, productosDe2y3consecutivos sólo tiene dos elementos.
|
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 |
import Test.QuickCheck -- 1ª definición productos1 :: Integer -> Integer -> [[Integer]] productos1 n x = [[y..y+n-1] | y <- [1..x] , product [y..y+n-1] == x] -- 2ª definición productos2 :: Integer -> Integer -> [[Integer]] productos2 n x = [[z..z+n-1] | z <- [1..y] , product [z..z+n-1] == x] where y = head (filter (\y -> y^n >= x) [2..]) productos :: Integer -> Integer -> [[Integer]] productos = productos2 prop_productos n x = n > 0 && x > 0 ==> productos n (product [x..x+n-1]) == [[x..x+n-1]] -- La comprobación es -- λ> quickCheck prop_productos -- +++ OK, passed 100 tests. -- (0.10 secs, 26409644 bytes) productosDe2y3consecutivos :: [Integer] productosDe2y3consecutivos = [x | x <- [1..] , (not . null) (productos 2 x) , (not . null) (productos 3 x)] -- El cálculo es -- λ> take 2 productosDe2y3consecutivos -- [6,210] -- λ> productos 2 210 -- [[14,15]] -- λ> productos 3 210 -- [[5,6,7]] |
«El verdadero viaje de descubrimiento no consiste en buscar nuevos paisajes sino en tener nuevos ojos.»
La conjetura de Goldbach afirma que
Todo número entero mayor que 5 se puede escribir como suma de tres números primos.
En este ejercicio consideraremos la variación consistente en exigir que los tres sumandos sean distintos.
Definir las funciones
|
1 2 3 |
sumas3PrimosDistintos :: Int -> [(Int,Int,Int)] conKsumas3PrimosDistintos :: Int -> Int -> [Int] noSonSumas3PrimosDistintos :: Int -> [Int] |
tales que
|
1 2 3 4 |
sumas3PrimosDistintos 26 == [(13,11,2),(17,7,2),(19,5,2)] sumas3PrimosDistintos 18 == [(11,5,2),(13,3,2)] sumas3PrimosDistintos 10 == [(5,3,2)] sumas3PrimosDistintos 11 == [] |
|
1 2 3 4 |
conKsumas3PrimosDistintos 3 99 == [26,27,29,32,36,42,46,48,54,58,60] conKsumas3PrimosDistintos 2 99 == [18,20,21,22,23,24,25,28,30,34,64,70] conKsumas3PrimosDistintos 1 99 == [10,12,14,15,16,19,40] conKsumas3PrimosDistintos 0 99 == [11,13,17] |
|
1 2 |
noSonSumas3PrimosDistintos 99 == [11,13,17] noSonSumas3PrimosDistintos 500 == [11,13,17] |
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 |
import Data.Numbers.Primes sumas3PrimosDistintos :: Int -> [(Int,Int,Int)] sumas3PrimosDistintos n = [(a,b,c) | a <- takeWhile (<=n-5) primes , b <- takeWhile (<a) primes , let c = n - a - b , c < b , isPrime c] conKsumas3PrimosDistintos :: Int -> Int -> [Int] conKsumas3PrimosDistintos k n = [x | x <- [1..n] , length (sumas3PrimosDistintos x) == k] noSonSumas3PrimosDistintos :: Int -> [Int] noSonSumas3PrimosDistintos = conKsumas3PrimosDistintos 0 |
«Cualquier tonto puede escribir un código que un ordenador puede entender. Los buenos programadores escriben código que los humanos pueden entender.»
Una forma de la conjetura de Golbach afirma que todo entero mayor que 1 se puede escribir como la suma de uno, dos o tres números primos.
Si se define el índice de Goldbach de n > 1 como la mínima cantidad de primos necesarios para que su suma sea n, entonces la conjetura de Goldbach afirma que todos los índices de Goldbach de los enteros mayores que 1 son menores que 4.
Definir las siguientes funciones
|
1 2 |
indiceGoldbach :: Int -> Int graficaGoldbach :: Int -> IO () |
tales que
|
1 2 3 4 5 |
indiceGoldbach 2 == 1 indiceGoldbach 4 == 2 indiceGoldbach 27 == 3 sum (map indiceGoldbach [2..5000]) == 10619 maximum (map indiceGoldbach [2..5000]) == 3 |
Comprobar con QuickCheck la conjetura de Goldbach anterior.
|
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 |
import Data.Array import Data.Numbers.Primes import Graphics.Gnuplot.Simple import Test.QuickCheck -- 1ª definición -- ============= indiceGoldbach :: Int -> Int indiceGoldbach n = minimum (map length (particiones n)) particiones :: Int -> [[Int]] particiones n = v ! n where v = array (0,n) [(i,f i) | i <- [0..n]] where f 0 = [[]] f m = [x:y | x <- xs, y <- v ! (m-x), [x] >= take 1 y] where xs = reverse (takeWhile (<= m) primes) -- 2ª definición -- ============= indiceGoldbach2 :: Int -> Int indiceGoldbach2 x = head [n | n <- [1..], esSumaDe x n] -- (esSumaDe x n) se verifica si x se puede escribir como la suma de n -- primos. Por ejemplo, -- esSumaDe 2 1 == True -- esSumaDe 4 1 == False -- esSumaDe 4 2 == True -- esSumaDe 27 2 == False -- esSumaDe 27 3 == True esSumaDe :: Int -> Int -> Bool esSumaDe x 1 = isPrime x esSumaDe x n = or [esSumaDe (x-p) (n-1) | p <- takeWhile (<= x) primes] -- 3ª definición -- ============= indiceGoldbach3 :: Int -> Int indiceGoldbach3 x = head [n | n <- [1..], esSumaDe3 x n] esSumaDe3 :: Int -> Int -> Bool esSumaDe3 x n = a ! (x,n) where a = array ((2,1),(x,9)) [((i,j),f i j) | i <- [2..x], j <- [1..9]] f i 1 = isPrime i f i j = or [a!(i-k,j-1) | k <- takeWhile (<= i) primes] -- 4ª definición -- ============= indiceGoldbach4 :: Int -> Int indiceGoldbach4 n = v ! n where v = array (2,n) [(i,f i) | i <- [2..n]] f i | isPrime i = 1 | otherwise = 1 + minimum [v!(i-p) | p <- takeWhile (< (i-1)) primes] -- Comparación de eficiencia -- ========================= -- λ> sum (map indiceGoldbach [2..80]) -- 142 -- (2.66 secs, 1,194,330,496 bytes) -- λ> sum (map indiceGoldbach2 [2..80]) -- 142 -- (0.01 secs, 1,689,944 bytes) -- λ> sum (map indiceGoldbach3 [2..80]) -- 142 -- (0.03 secs, 27,319,296 bytes) -- λ> sum (map indiceGoldbach4 [2..80]) -- 142 -- (0.03 secs, 47,823,656 bytes) -- -- λ> sum (map indiceGoldbach2 [2..1000]) -- 2030 -- (0.10 secs, 200,140,264 bytes) -- λ> sum (map indiceGoldbach3 [2..1000]) -- 2030 -- (3.10 secs, 4,687,467,664 bytes) -- Gráfica -- ======= graficaGoldbach :: Int -> IO () graficaGoldbach n = plotList [ Key Nothing , XRange (2,fromIntegral n) , PNG ("Conjetura_de_Goldbach_" ++ show n ++ ".png") ] [indiceGoldbach2 k | k <- [2..n]] -- Comprobación de la conjetura de Goldbach -- ======================================== -- La propiedad es prop_Goldbach :: Int -> Property prop_Goldbach x = x >= 2 ==> indiceGoldbach2 x < 4 -- La comprobación es -- λ> quickCheck prop_Goldbach -- +++ OK, passed 100 tests. |
«La diferencia entre los matemáticos y los físicos es que después de que los físicos prueban un gran resultado piensan que es fantástico, pero después de que los matemáticos prueban un gran resultado piensan que es trivial.»