Definir la función
|
1 |
ordPorFrecuencia :: Ord a => [a] -> [a] |
tal que (ordPorFrecuencia xs) es la lista obtenidas ordenando los elementos de xs por su frecuencia, de los que aparecen más a los que aparecen menos, y los que aparecen el mismo número de veces se ordenan de manera creciente según su valor. Por ejemplo,
|
1 2 3 |
ordPorFrecuencia "canalDePanama" == "aaaaannmlecPD" ordPorFrecuencia "11012018" == "11110082" ordPorFrecuencia [2,3,5,3,7,9,5,3,7] == [3,3,3,7,7,5,5,9,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 |
import Test.QuickCheck import Data.List (group, sort, sortBy) import Data.Function (on) -- 1ª solución -- =========== ordPorFrecuencia1 :: Ord a => [a] -> [a] ordPorFrecuencia1 xs = concatMap snd (reverse (sort [(length xs,xs) | xs <- group (sort xs)])) -- 2ª solución -- =========== ordPorFrecuencia2 :: Ord a => [a] -> [a] ordPorFrecuencia2 = concat . reverse . sortBy comparaPorLongitud . group . sort comparaPorLongitud :: [a] -> [a] -> Ordering comparaPorLongitud xs ys = compare (length xs) (length ys) -- 3ª solución -- =========== ordPorFrecuencia3 :: Ord a => [a] -> [a] ordPorFrecuencia3 = concat . reverse . sortBy (compare `on` length). group . sort -- Comparación de eficiencia -- ========================= -- λ> xs = show (2^2000000) -- λ> last (ordPorFrecuencia1 xs) -- '8' -- (1.45 secs, 938,345,320 bytes) -- λ> last (ordPorFrecuencia2 xs) -- '8' -- (1.33 secs, 900,239,200 bytes) -- λ> last (ordPorFrecuencia3 xs) -- '8' -- (1.30 secs, 900,241,848 bytes) |
Definir las siguientes funciones
|
1 2 3 |
numeroContado :: Integer -> Integer contadora :: Integer -> [Integer] lugarPuntoFijoContadora :: Integer -> Integer -> Maybe Integer |
tales que
|
1 2 3 4 |
numeroContado 1 == 11 numeroContado 114213 == 31121314 numeroContado 1111111111111111 == 161 numeroContado 555555555500 == 20105 |
|
1 2 3 4 5 6 |
λ> take 14 (contadora 1) [1,11,21,1112,3112,211213,312213,212223,114213,31121314,41122314, 31221324,21322314,21322314] λ> take 14 (contadora 5) [5,15,1115,3115,211315,31121315,41122315,3122131415,4122231415, 3132132415,3122331415,3122331415,3122331415,3122331415] |
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
λ> lugarPuntoFijoContadora 1 100 Just 12 λ> contadora 1 !! 11 31221324 λ> contadora 1 !! 12 21322314 λ> contadora 1 !! 13 21322314 λ> lugarPuntoFijoContadora 1 10 Nothing λ> lugarPuntoFijoContadora 5 20 Just 10 λ> lugarPuntoFijoContadora 40 200 Nothing |
Nota: Este ejercicio ha sido propuesto por Ángel Ruiz.
|
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 |
import Data.List ( genericLength , genericTake , group , nub , sort ) -- Definición de numeroContado numeroContado :: Integer -> Integer numeroContado n = (read . concat . map concat) [[(show . length) m,nub m] | m <- (group . sort . show) n] -- 1ª definición de contadora contadora :: Integer -> [Integer] contadora n = n : map numeroContado (contadora n) -- 2ª definición de contadora contadora2 :: Integer -> [Integer] contadora2 = iterate numeroContado -- Definición de lugarPuntoFijoContadora lugarPuntoFijoContadora :: Integer -> Integer -> Maybe Integer lugarPuntoFijoContadora n k | m == k-1 = Nothing | otherwise = Just m where xs = genericTake k (contadora n) ds = zipWith (-) xs (tail xs) m = genericLength (takeWhile (/=0) ds) |
Definir las siguientes funciones
|
1 2 |
pares :: Integer -> Integer -> [(Integer,Integer)] nPares :: Integer -> Integer -> Integer |
tales que
|
1 2 3 4 5 6 7 |
pares 3 3 == [(3,3)] pares 4 12 == [(4,12),(12,4)] pares 2 12 == [(2,12),(4,6),(6,4),(12,2)] pares 2 60 == [(2,60),(4,30),(6,20),(10,12),(12,10),(20,6),(30,4),(60,2)] pares 2 7 == [] pares 12 3 == [] length (pares 3 (product [3,5..91])) == 8388608 |
|
1 2 3 4 5 6 7 8 |
nPares 3 3 == 1 nPares 4 12 == 2 nPares 2 12 == 4 nPares 2 60 == 8 nPares 2 7 == 0 nPares 12 3 == 0 nPares 3 (product [3..3*10^4]) `mod` (10^12) == 477999992832 length (show (nPares 3 (product [3..3*10^4]))) == 977 |
|
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 |
import Data.Numbers.Primes (primeFactors) import Data.List (genericLength, group, nub, sort, subsequences) import Test.QuickCheck -- 1ª definición de pares -- ====================== pares1 :: Integer -> Integer -> [(Integer,Integer)] pares1 a b = [(x,y) | x <- [1..b] , y <- [1..b] , gcd x y == a , lcm x y == b] -- 2ª definición de pares -- ====================== pares2 :: Integer -> Integer -> [(Integer,Integer)] pares2 a b = [(x,y) | x <- [a,a+a..b] , y <- [a,a+a..b] , gcd x y == a , lcm x y == b] -- Comparacioń de eficiencia -- λ> length (pares1 3 (product [3,5..11])) -- 16 -- (95.12 secs, 86,534,165,528 bytes) -- λ> length (pares2 3 (product [3,5..11])) -- 16 -- (15.80 secs, 14,808,762,128 bytes) -- 3ª definición de pares -- ====================== pares3 :: Integer -> Integer -> [(Integer,Integer)] pares3 a b = [(x,y) | x <- [a,a+a..b] , c `rem` x == 0 , let y = c `div` x , gcd x y == a ] where c = a * b -- Comparacioń de eficiencia -- λ> length (pares2 3 (product [3,5..11])) -- 16 -- (15.80 secs, 14,808,762,128 bytes) -- λ> length (pares3 3 (product [3,5..11])) -- 16 -- (0.01 secs, 878,104 bytes) -- 4ª definición de pares -- ====================== -- Para la cuarta definición de pares se observa la relación con los -- factores primos -- λ> [(primeFactors x, primeFactors y) | (x,y) <- pares1 2 12] -- [([2],[2,2,3]),([2,2],[2,3]),([2,3],[2,2]),([2,2,3],[2])] -- λ> [primeFactors x | (x,y) <- pares1 2 12] -- [[2],[2,2],[2,3],[2,2,3]] -- λ> [primeFactors x | (x,y) <- pares1 2 60] -- [[2],[2,2],[2,3],[2,5],[2,2,3],[2,2,5],[2,3,5],[2,2,3,5]] -- λ> [primeFactors x | (x,y) <- pares1 6 60] -- [[2,3],[2,2,3],[2,3,5],[2,2,3,5]] -- λ> [primeFactors x | (x,y) <- pares1 2 24] -- [[2],[2,3],[2,2,2],[2,2,2,3]] -- Se observa que cada pare se obtiene de uno de los subconjuntos de los -- divisores primos de b/a. Por ejemplo, -- λ> (a,b) = (2,24) -- λ> b `div` a -- 12 -- λ> primeFactors it -- [2,2,3] -- λ> group it -- [[2,2],[3]] -- λ> subsequences it -- [[],[[2,2]],[[3]],[[2,2],[3]]] -- λ> map concat it -- [[],[2,2],[3],[2,2,3]] -- λ> map product it -- [1,4,3,12] -- λ> [(a * x, b `div` x) | x <- it] -- [(2,24),(8,6),(6,8),(24,2)] -- A partir de la observación se construye la siguiente definición pares4 :: Integer -> Integer -> [(Integer,Integer)] pares4 a b | b `mod` a /= 0 = [] | otherwise = [(a * x, b `div` x) | x <- map (product . concat) ((subsequences . group . primeFactors) (b `div` a))] -- Nota. La función pares4 calcula el mismo conjunto que las anteriores, -- pero no necesariamente en el mismo orde. Por ejemplo, -- λ> pares3 2 60 -- [(2,60),(4,30),(6,20),(10,12),(12,10),(20,6),(30,4),(60,2)] -- λ> pares4 2 60 -- [(2,60),(4,30),(6,20),(12,10),(10,12),(20,6),(30,4),(60,2)] -- λ> pares3 2 60 == sort (pares4 2 60) -- True -- Comparacioń de eficiencia -- λ> length (pares3 3 (product [3,5..17])) -- 64 -- (4.44 secs, 2,389,486,440 bytes) -- λ> length (pares4 3 (product [3,5..17])) -- 64 -- (0.00 secs, 177,704 bytes) -- Propiedades de equivalencia de pares -- ==================================== prop_pares :: Integer -> Integer -> Property prop_pares a b = a > 0 && b > 0 ==> all (== pares1 a b) [sort (f a b) | f <- [ pares2 , pares3 , pares4 ]] prop_pares2 :: Integer -> Integer -> Property prop_pares2 a b = a > 0 && b > 0 ==> all (== pares1 a (a * b)) [sort (f a (a * b)) | f <- [ pares2 , pares3 , pares4 ]] -- La comprobación es -- λ> quickCheckWith (stdArgs {maxSize=10}) prop_pares -- +++ OK, passed 100 tests. -- λ> quickCheckWith (stdArgs {maxSize=10}) prop_pares -- +++ OK, passed 100 tests. -- λ> quickCheckWith (stdArgs {maxSize=10}) prop_pares2 -- +++ OK, passed 100 tests. -- 1ª definición de nPares -- ======================= nPares1 :: Integer -> Integer -> Integer nPares1 a b = genericLength (pares4 a b) -- 2ª definición de nPares -- ======================= nPares2 :: Integer -> Integer -> Integer nPares2 a b = 2^(length (nub (primeFactors (b `div` a)))) -- Comparación de eficiencia -- λ> nPares1 3 (product [3,5..91]) -- 8388608 -- (4.68 secs, 4,178,295,920 bytes) -- λ> nPares2 3 (product [3,5..91]) -- 8388608 -- (0.00 secs, 234,688 bytes) -- Propiedad de equivalencia de nPares -- =================================== prop_nPares :: Integer -> Integer -> Property prop_nPares a b = a > 0 && b > 0 ==> nPares1 a (a * b) == nPares2 a (a * b) -- La comprobación es -- λ> quickCheckWith (stdArgs {maxSize=10}) prop_nPares -- +++ OK, passed 100 tests. |
Definir la función
|
1 |
reducida :: Eq a => [a] -> [a] |
tal que (reducida xs) es la lista obtenida a partir de xs de forma que si hay dos o más elementos idénticos consecutivos, borra las repeticiones y deja sólo el primer elemento. Por ejemplo,
|
1 2 |
ghci> reducida "eesssooo essss toodddooo" "eso es todo" |
Nota: Basado en el ejercicio Apaxiaaaaaaaaaaaans! de Kattis.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
import Data.List (group) -- 1ª solución (por recursión): reducida1 :: Eq a => [a] -> [a] reducida1 [] = [] reducida1 (x:xs) = x : reducida1 (dropWhile (==x) xs) -- 2ª solución (por comprensión): reducida2 :: Eq a => [a] -> [a] reducida2 xs = [x | (x:_) <- group xs] -- 3ª solución (sin argumentos): reducida3 :: Eq a => [a] -> [a] reducida3 = map head . group |
Se pueden generar los dígitos de Pi, como se explica en el artículo Unbounded spigot algorithms for the digits of pi, con 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 sucesión «Mira y di» (en inglés, Look-and-Say) es una sucesión de números naturales en donde cada término se obtiene agrupando las cifras iguales del anterior y recitándolas. Por ejemplo, si x(0) = 1 se lee como «un uno» y por tanto x(1) = 11. Análogamente,
|
1 2 3 4 5 |
x(1) = 11 ("dos unos --> "21") x(2) = 21 ("un dos un uno --> "1211") x(3) = 1211 ("un uno un dos dos unos --> "111221") x(4) = 111221 ("tres unos dos doses un uno --> "312211") x(5) = 312211 ("un tres un uno dos doses dos unos --> "13112221") |
Definir la función
|
1 |
sucMiraYDi :: Integer -> [Integer] |
tal que (sucMiraYDi n) es la sucesión «Mira y di» cuyo primer término es n. Por ejemplo,
|
1 2 3 4 5 6 7 8 9 10 |
λ> take 9 (sucMiraYdi 1) [1,11,21,1211,111221,312211,13112221,1113213211,31131211131221] λ> take 5 (sucMiraYdi 2017) [2017,12101117,111211103117,31123110132117,1321121321101113122117] λ> take 7 (sucMiraYDi 22) [22,22,22,22,22,22,22] λ> (sucMiraYDi 1) !! 11 3113112221232112111312211312113211 λ> (sucMiraYDi 1) !! 12 1321132132111213122112311311222113111221131221 |
Independientemente del término inicial x(0) elegido (con la única salvedad del 22), la sucesión diverge y la razón entre el número de cifras de x(n) y el de x(n-1) tiende a un valor fijo que es la constante de Conway λ ≈ 1.303577269. Por ejemplo, para x(0) = 1, las razones son
|
1 |
2, 1, 2, 1.5, 1, 1.3333333333333333, 1.25, 1.4, 1.4285714285714286, 1.3 |
Definir la función
|
1 |
aproximacionConway :: Integer -> Double -> Int |
tal que (aproximacionConway n e) es el menor k tal que la diferencia entre la constante de Conway y la razón entre el número de cifras de x(k) x(k-1) es, en valor absoluto, menor que e. Por ejemplo,
|
1 2 3 4 5 6 |
aproximacionConway 1 0.3 == 3 aproximacionConway 1 0.1 == 5 aproximacionConway 1 0.01 == 9 aproximacionConway 1 0.001 == 24 aproximacionConway 1 0.0001 == 43 aproximacionConway 2 0.0001 == 47 |
Nota: Este ejercicio ha sido propuesto por Elías Guisado.
|
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 |
import Data.List (genericLength, group) -- 1ª solución -- =========== sucMiraYdi :: Integer -> [Integer] sucMiraYdi = iterate di -- (di x) es el número correspondiente a la lectura de x. Por ejemplo. -- di 1 == 11 -- di 11 == 21 -- di 21 == 1211 -- di 1211 == 111221 -- di 111221 == 312211 -- di 312211 == 13112221 di :: Integer -> Integer di = read . concatMap aux . group . show where aux s = show (length s) ++ [head s] -- 2ª solución -- =========== sucMiraYdi2 :: Integer -> [Integer] sucMiraYdi2 = iterate (read . concatMap aux . group . show) where aux s = show (length s) ++ [head s] -- Constante de Conway -- =================== aproximacionConway :: Integer -> Double -> Int aproximacionConway n e = length (takeWhile aux (razonesMiraYdi n)) where aux x = abs (x - constanteConway) > e constanteConway :: Double constanteConway = 1.303577269 -- (razonesMiraYdi n) es la sucesión de las razones entre de cada -- elemento de la sucesión "Mira y di" con elemento inicial n y su -- anterior. Por ejemplo, -- λ> take 10 (razonesMiraYdi 1) -- [2.0,1.0,2.0,1.5,1.0,1.3333333333333333,1.25,1.4,1.4285714285714286,1.3] -- λ> take 7 (razonesMiraYdi 10) -- [2.0,1.0,1.5,1.6666666666666667,1.2,1.1666666666666667,1.5714285714285714] razonesMiraYdi :: Integer -> [Double] razonesMiraYdi n = zipWith (/) (tail xs) xs where xs = map (genericLength . show) (sucMiraYdi n) |
Definir la función
|
1 |
nMinimoCambios :: Ord a => [a] -> Int |
tal que (nMinimoCambios xs) es el menor número de elementos de xs que hay que cambiar para que todos sean iguales. Por ejemplo,
|
1 2 3 4 |
nMinimoCambios [3,5,3,7,9,6] == 4 nMinimoCambios [3,5,3,7,3,3] == 2 nMinimoCambios "Salamanca" == 5 nMinimoCambios (4 : [1..500000]) == 499999 |
En el primer ejemplo, los elementos que hay que cambiar son 5, 7, 9 y 6.
|
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 |
import Data.List (group, nub, sort) -- 1ª definición -- ============= nMinimoCambios1 :: Ord a => [a] -> Int nMinimoCambios1 xs = length xs - fst (last (sort (frecuencias xs))) -- (frecuencias xs) es la lista de los pares de los elementos de xs y el -- número de veces que ocurren en xs. Por ejemplo, -- frecuencias [3,5,3,7,9,6] == [(2,3),(1,5),(1,7),(1,9),(1,6)] -- frecuencias [3,5,3,7,5,5] == [(2,3),(3,5),(1,7)] frecuencias :: Ord a => [a] -> [(Int,a)] frecuencias xs = [(cuenta x xs,x) | x <- nub xs] -- (cuenta x ys) es el número de veces que ocurre x en ys. Por ejemplo, -- cuenta 3 [3,5,3,7,9,6] == 2 cuenta :: Ord a => a -> [a] -> Int cuenta x ys = length [y | y <- ys, y == x] -- 2ª definición -- ============= nMinimoCambios2 :: Ord a => [a] -> Int nMinimoCambios2 xs = length xs - fst (last (sort (frecuencias2 xs))) -- (frecuencias2 xs) es la lista de los pares de los elementos de xs y el -- número de veces que ocurren en xs. Por ejemplo, -- frecuencias2 [3,5,3,7,9,6] == [(2,3),(1,5),(1,7),(1,9),(1,6)] -- frecuencias2 [3,5,3,7,5,5] == [(2,3),(3,5),(1,7)] frecuencias2 :: Ord a => [a] -> [(Int,a)] frecuencias2 xs = [(1 + length ys, y) | (y:ys) <- group (sort xs)] -- 3ª definición -- ============= nMinimoCambios3 :: Ord a => [a] -> Int nMinimoCambios3 xs = sum ys - maximum ys where ys = [length ys | ys <- group (sort xs)] |
Definir la función
|
1 |
nDivisoresPar :: Integer -> Bool |
tal que (nDivisoresPar n) se verifica si n tiene un número par de divisores. Por ejemplo,
|
1 2 3 |
nDivisoresPar 12 == True nDivisoresPar 16 == False nDivisoresPar (product [1..2*10^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 |
import Data.List (group) import Data.Numbers.Primes (primeFactors) -- 1ª definición -- ============= nDivisoresPar1 :: Integer -> Bool nDivisoresPar1 = even . length . divisores -- (divisores n) es la lista de los divisores de n. Por ejemplo, -- divisores 12 == [1,2,3,4,6,12] -- divisores 16 == [1,2,4,8,16] divisores :: Integer -> [Integer] divisores n = [x | x <- [1..n], n `mod` x == 0] -- 2ª definición -- ============= nDivisoresPar2 :: Integer -> Bool nDivisoresPar2 n = any odd (map length (group (primeFactors n))) -- Comparación de eficiencia -- ========================= -- λ> nDivisoresPar1 (10^7) -- True -- (14.18 secs, 2,078,736,992 bytes) -- λ> nDivisoresPar2 (10^7) -- True -- (0.01 secs, 0 bytes) -- -- λ> nDivisoresPar2 (product [1..2*10^4]) -- True -- (2.30 secs, 1,003,013,112 bytes) |
|
1 2 3 4 5 6 7 8 9 10 11 |
/* concat(xs) es la lista obtenida concatenado los elementos de xss. Por ejemplo, concat([[1,3],[2,4],[5,7]]) == [1, 3, 2, 4, 5, 7] */ concat (xs) := block ([r:[]], for x in reverse (xs) do r : append (x,r), r)$ nDivisoresPares (n) := block( [xs : concat (map (rest, ifactors (n))), p : false], for x in xs do p: oddp (x) or p, p)$ |
El enunciado del problema 652 de Números y algo más es el siguiente
Si factorizamos los factoriales de un número en función de sus divisores primos y sus potencias, ¿Cuál es el menor número n tal que entre los factores primos y los exponentes de estos, n! contiene los dígitos del cero al nueve? Por ejemplo
- 6! = 2⁴x3²x5¹, le faltan los dígitos 0,6,7,8 y 9
- 12! = 2¹⁰x3⁵x5²x7¹x11¹, le faltan los dígitos 4,6,8 y 9
Definir la función
|
1 |
digitosDeFactorizacion :: Integer -> [Integer] |
tal que (digitosDeFactorizacion n) es el conjunto de los dígitos que aparecen en la factorización de n. Por ejemplo,
|
1 2 |
digitosDeFactorizacion (factorial 6) == [1,2,3,4,5] digitosDeFactorizacion (factorial 12) == [0,1,2,3,5,7] |
Usando la función anterior, calcular la solución del problema.
Comprobar con QuickCheck que si n es mayor que 100, entonces
|
1 |
digitosDeFactorizacion (factorial n) == [0..9] |
|
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 |
import Data.List (genericLength, group, nub, sort) import Data.Numbers.Primes (primeFactors) import Test.QuickCheck -- 1ª definición -- ============= digitosDeFactorizacion1 :: Integer -> [Integer] digitosDeFactorizacion1 n = sort (nub (concat [digitos x | x <- numerosDeFactorizacion n])) -- (digitos n) es la lista de los digitos del número n. Por ejemplo, -- digitos 320274 == [3,2,0,2,7,4] digitos :: Integer -> [Integer] digitos n = [read [x] | x <- show n] -- (numerosDeFactorizacion n) es el conjunto de los números en la -- factorización de n. Por ejemplo, -- numerosDeFactorizacion 60 == [1,2,3,5] numerosDeFactorizacion :: Integer -> [Integer] numerosDeFactorizacion n = sort (nub (aux (factorizacion n))) where aux [] = [] aux ((x,y):zs) = x : y : aux zs -- (factorización n) es la factorización de n. Por ejemplo, -- factorizacion 300 == [(2,2),(3,1),(5,2)] factorizacion :: Integer -> [(Integer,Integer)] factorizacion n = [(head xs, genericLength xs) | xs <- group (factorizacion' n)] -- (factorizacion' n) es la lista de todos los factores primos de n; es -- decir, es una lista de números primos cuyo producto es n. Por ejemplo, -- factorizacion 300 == [2,2,3,5,5] factorizacion' :: Integer -> [Integer] factorizacion' n | n == 1 = [] | otherwise = x : factorizacion' (div n x) where x = menorFactor n -- (menorFactor n) es el menor factor primo de n. Por ejemplo, -- menorFactor 15 == 3 menorFactor :: Integer -> Integer menorFactor n = head [x | x <- [2..], rem n x == 0] -- (factorial n) es el factorial de n. Por ejemplo, -- factorial 5 == 120 factorial :: Integer -> Integer factorial n = product [1..n] -- 2ª definición -- ============= digitosDeFactorizacion2 :: Integer -> [Integer] digitosDeFactorizacion2 n = sort (nub (concat [digitos x | x <- numerosDeFactorizacion2 n])) -- (numerosDeFactorizacion2 n) es el conjunto de los números en la -- factorización de n. Por ejemplo, -- numerosDeFactorizacion2 60 == [1,2,3,5] numerosDeFactorizacion2 :: Integer -> [Integer] numerosDeFactorizacion2 n = sort (nub (aux (factorizacion2 n))) where aux xs = concat [[a,b] | (a,b) <- xs] -- (factorización2 n) es la factorización de n. Por ejemplo, -- factorizacion2 300 == [(2,2),(3,1),(5,2)] factorizacion2 :: Integer -> [(Integer,Integer)] factorizacion2 n = [(head xs, genericLength xs) | xs <- group (primeFactors n)] -- 3ª definición -- ============= digitosDeFactorizacion3 :: Integer -> [Integer] digitosDeFactorizacion3 n = sort (nub (concat [digitos x | x <- aux (group (primeFactors n))])) where aux [] = [] aux (ys@(y:_):xss) = y : genericLength ys : aux xss -- Definición -- ========== digitosDeFactorizacion :: Integer -> [Integer] digitosDeFactorizacion = digitosDeFactorizacion3 -- Solución -- ======== -- Para calcular la solución, se define la constante solucion :: Integer solucion = head [n | n <- [1..], digitosDeFactorizacion (factorial n) == [0..9]] -- El cálculo de la solución es -- ghci> solucion2 -- 49 -- Propiedad -- ========= -- La propiedad es prop_completa :: Integer -> Bool prop_completa n = digitosDeFactorizacion (factorial n1) == [0..9] where n1 = 101 + abs n -- La comprobación es -- λ> quickCheck prop_completa -- +++ OK, passed 100 tests. |
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 |
/* digitos(n) es la lista de los digitos del número n. Por ejemplo, digitos (320274) == [3,2,0,2,7,4] */ digitos (n) := charlist (string (n))$ digitosDeFactorizacion (n) := unique (apply (append, map (digitos, apply (append, ifactors (n))))) $ solucion () := block ([n:1], while length (digitosDeFactorizacion (n!)) < 10 do n : n+1, n)$ /* (%i5) digitosDeFactorizacion (6!); (%o5) [1, 2, 3, 4, 5] (%i6) solucion (); (%o6) 49 */ |
Definir la función
|
1 |
ordPorFrecuencia :: Ord a => [a] -> [a] |
tal que (ordPorFrecuencia xs) es la lista obtenidas ordenando los elementos de xs por su frecuencia, de los que aparecen menos a los que aparecen más. Por ejemplo,
|
1 2 |
ordPorFrecuencia "canalDePanama" == "DPcelmnnaaaaa" ordPorFrecuencia "20012016" == "61122000" |
|
1 2 3 4 5 |
import Data.List (group, sort) ordPorFrecuencia :: Ord a => [a] -> [a] ordPorFrecuencia xs = concatMap snd (sort [(length xs,xs) | xs <- group (sort xs)]) |
La cuadrícula entera de lado n, Cₙ, es el conjunto de los puntos (x,y) donde x e y son números enteros tales que 1 ≤ x, y ≤ n.
Un punto (x,y) de Cₙ es visible desde el origen si el máximo común divisor de x e y es 1. Por ejemplo, el punto (4,6) no es visible porque está ocultado por el (2,3); en cambio, el (2,3) sí es visible.
El conjunto de los puntos visibles en la cuadrícula entera de lado 6 son (1,1), (1,2), (1,3), (1,4), (1,5), (1,6), (2,1), (2,3), (2,5), (3,1), (3,2), (3,4), (3,5), (4,1), (4,3), (4,5), (5,1), (5,2), (5,3), (5,4), (5,6), (6,1) y (6,5).
Definir la función
|
1 |
nVisibles :: Integer -> Integer |
tal que (nVisibles n) es el número de los puntos visibles en la cuadrícula de lado n.Por ejemplo,
|
1 2 3 4 5 6 |
nVisibles 6 == 23 nVisibles 10 == 63 nVisibles 100 == 6087 nVisibles 1000 == 608383 nVisibles 10000 == 60794971 nVisibles 100000 == 6079301507 |
|
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 |
import Data.List (genericLength, group, sort) import Data.Numbers.Primes (primeFactors) type Punto = (Integer,Integer) -- (visible p) se verifica si el punto p es visible. Por ejemplo, -- visible (4,5) == True -- visible (4,6) == False visible :: Punto -> Bool visible (x,y) = gcd x y == 1 -- (visibles n) es el conjunto de los puntos visibles en la cuadrícula -- de lado 1. Por ejemplo, -- cuadrado 1 <= x, y <= n. Por ejemplo, -- λ> sort (visibles 6) -- [(1,1),(1,2),(1,3),(1,4),(1,5),(1,6),(2,1),(2,3),(2,5),(3,1),(3,2),(3,4), -- (3,5),(4,1),(4,3),(4,5),(5,1),(5,2),(5,3),(5,4),(5,6),(6,1),(6,5)] -- 1ª definición de visibles visibles1 :: Integer -> [Punto] visibles1 n = [(x,y) | x <- [1..n], y <- [1..n], visible (x,y)] -- 2ª definición de visibles visibles2 :: Integer -> [Punto] visibles2 n = (1,1) : ps ++ [(y,x) | (x,y) <- ps] where ps = [(x,y) | x <- [1..n], y <- [x+1..n], visible (x,y)] -- Comparación de eficiencia -- ========================= -- λ> length (visibles1 1000) -- 608383 -- (3.40 secs, 758,346,208 bytes) -- λ> length (visibles2 1000) -- 608383 -- (2.22 secs, 464,276,856 bytes) -- Usaremos la 2ª definición de visibles visibles :: Integer -> [Punto] visibles = visibles2 -- 1ª definición de nVisibles nVisibles1 :: Integer -> Integer nVisibles1 = genericLength . visibles -- 2ª definición de nVisibles nVisibles2 :: Integer -> Integer nVisibles2 n = 1 + 2 * genericLength [(x,y) | x <- [1..n], y <- [x+1..n], visible (x,y)] -- 3ª definición de nVisibles nVisibles3 :: Integer -> Integer nVisibles3 1 = 1 nVisibles3 n = nVisibles3 (n-1) + (2 * phi n) -- La función φ de Euler (del ejercicio anterior). phi :: Integer -> Integer phi n = product [(p-1)*p^(e-1) | (p,e) <- factorizacion n] factorizacion :: Integer -> [(Integer,Integer)] factorizacion n = [(head xs,genericLength xs) | xs <- group (primeFactors n)] -- 4ª definición de nVisibles nVisibles4 :: Integer -> Integer nVisibles4 n = 2 * sum [phi x | x <- [1..n]] - 1 -- Comparación de eficiencia -- ========================= -- λ> nVisibles1 1000 -- 608383 -- (2.69 secs, 521,599,512 bytes) -- λ> nVisibles2 1000 -- 608383 -- λ> nVisibles3 1000 -- 608383 -- (0.05 secs, 0 bytes) -- λ> nVisibles4 1000 -- 608383 -- (0.04 secs, 0 bytes) |
En una lista xs se produce un cambio de signo por cada elemento x de la lista junto el primero de los elementos de xs con signo opuesto al de x. Por ejemplo,en la lista [6,5,-4,0,-2,-7,0,-8,-1,4] hay 2 cambios de signo (entre (5,-4) y (-1,4)) y en la lista [6,5,-4,0, 2,-7,0,-8,-1,4] hay 4 cambios de signo (entre (5,-4), (-4,2), (2,-7) y(-1,4)).
Definir la función
|
1 |
nCambios :: (Num a, Ord a) => [a] -> Int |
tal que (nCambios xs) es el número de cambios de signos de la lista xs. Por ejemplo,
|
1 2 3 |
nCambios [] == 0 nCambios [6,5,-4,0,-2,-7,0,-8,-1,4] == 2 nCambios [6,5,-4,0, 2,-7,0,-8,-1,4] == 4 |
|
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.List (group) -- 1ª definición nCambios1 :: (Num a, Ord a) => [a] -> Int nCambios1 = length . cambios -- (cambios xs) es la lista de los pares de elementos de xs entre los -- que se producen cambios de signo. Por ejemplo, -- cambios [6,5,-4,0,-2,-7,0,-8,-1,4] == [(5,-4),(-1,4)] -- cambios [6,5,-4,0, 2,-7,0,-8,-1,4] == [(5,-4),(-4,2),(2,-7),(-1,4)] cambios :: (Num a, Ord a) => [a] -> [(a,a)] cambios xs = [(x,y) | (x,y) <- zip ys (tail ys), x*y < 0] where ys = filter (/=0) xs -- 2ª definición nCambios2 :: (Num a, Ord a) => [a] -> Int nCambios2 [] = 0 nCambios2 xs = length (group (filter (/=0) (map signum xs))) - 1 -- 3ª definición nCambios3 :: (Num a, Ord a) => [a] -> Int nCambios3 = pred . length . group . filter (/=0) . map signum -- Comparación de eficiencia -- ========================= -- λ> nCambios1 (take (2*10^6) (cycle [3,0,-3])) -- 1333332 -- (3.84 secs, 679,805,392 bytes) -- λ> nCambios2 (take (2*10^6) (cycle [3,0,-3])) -- 1333332 -- (0.98 secs, 694,247,368 bytes) -- λ> nCambios3 (take (2*10^6) (cycle [3,0,-3])) -- 1333332 -- (0.95 secs, 708,118,976 bytes) |
La parte libre de cuadrados de un número n es el producto de todos sus divisores primos con exponente impar en la factorización prima de n. Por ejemplo, la parte libre de cuadrados de 360 es 10 ya que 360 = 2³3²5 y 2.5 = 10; además, 360 = 10.6²
La parte cuadrada de un número n es el mayor número cuadrado que divide a n. Por ejemplo, la parte cuadrada de 360 es 6.
Definir las funciones
|
1 2 |
parteLibre :: Integer -> Integer parteCuadrada :: Integer -> Integer |
tales que
|
1 2 3 |
parteLibre 360 == 10 parteLibre 1800 == 2 [parteLibre n | n <- [1..14]] == [1,2,3,1,5,6,7,2,1,10,11,3,13,14] |
|
1 2 3 |
parteCuadrada 360 == 36 parteCuadrada 1800 == 900 [parteCuadrada n | n <- [1..14]] == [1,1,1,4,1,1,1,4,9,1,1,4,1,1] |
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 |
import Data.List (group, genericLength) import Data.Numbers.Primes (primeFactors) parteLibre :: Integer -> Integer parteLibre n = product [p | (p,e) <- factorizacion n, odd e] -- (factorizacion n) es la factorización de n. Por ejemplo, -- factorizacion 600 == [(2,3),(3,1),(5,2)] -- factorizacion 1400 == [(2,3),(5,2),(7,1)] factorizacion :: Integer -> [(Integer,Integer)] factorizacion n = [(head xs,genericLength xs) | xs <- group (primeFactors n)] parteCuadrada :: Integer -> Integer parteCuadrada n = n `div` parteLibre n |
Un entero positivo n es un número práctico si todos los enteros positivos menores que él se pueden expresar como suma de distintos divisores de n. Por ejemplo, el 12 es un número práctico, ya que todos los enteros positivos menores que 12 se pueden expresar como suma de divisores de 12 (1, 2, 3, 4 y 6) sin usar ningún divisor más de una vez en cada suma:
|
1 2 3 4 5 6 7 8 9 10 11 |
1 = 1 2 = 2 3 = 3 4 = 4 5 = 2 + 3 6 = 6 7 = 1 + 6 8 = 2 + 6 9 = 3 + 6 10 = 4 + 6 11 = 1 + 4 + 6 |
En cambio, 14 no es un número práctico ya que 6 no se puede escribir como suma, con sumandos distintos, de divisores de 14.
Definir la función
|
1 |
esPractico :: Integer -> Bool |
tal que (esPractico n) se verifica si n es un número práctico. Por ejemplo,
|
1 2 3 4 |
esPractico 12 == True esPractico 14 == False esPractico 2016 == True esPractico 42535295865117307932921825928971026432 == 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 |
import Data.List (genericLength, group, nub, sort, subsequences) import Data.Numbers.Primes (primeFactors) import Graphics.Gnuplot.Simple -- 1ª definición -- ============= esPractico1 :: Integer -> Bool esPractico1 n = takeWhile (<n) (sumas (divisores n)) == [0..n-1] -- (divisores n) es la lista de los divisores de n. Por ejemplo, -- divisores 12 == [1,2,3,4,6] -- divisores 14 == [1,2,7] divisores :: Integer -> [Integer] divisores n = [k | k <- [1..n-1], n `mod` k == 0] -- (sumas xs) es la lista ordenada de números que se pueden obtener como -- sumas de elementos de xs sin usar ningún elemento más de una vez en -- cada suma. Por ejemplo, -- sumas [1,2,3] == [0,1,2,3,4,5,6] -- sumas [1,2,7] == [0,1,2,3,7,8,9,10] sumas :: [Integer] -> [Integer] sumas xs = sort (nub (map sum (subsequences xs))) -- 2ª definición -- ============= esPractico2 :: Integer -> Bool esPractico2 n = all (esSumable (divisores n)) [1..n-1] -- (esSumable xs n) se verifica si n se puede escribir como una suma de -- elementos distintos de la lista creciente xs. Por ejemplo, -- esSumable [1,2,7] 8 == True -- esSumable [1,2,7] 6 == False -- esSumable [1,2,7] 4 == False -- esSumable [1,2,7] 2 == True -- esSumable [1,2,7] 0 == True esSumable :: [Integer] -> Integer -> Bool esSumable _ 0 = True esSumable [] _ = False esSumable (x:xs) n = x <= n && (esSumable xs (n-x) || esSumable xs n) -- 3ª definición -- ============= -- Usando la caracterización de Stewart y Sierpiński: un entero n >= 2 -- es práctico syss para su factorización prima -- n = p(1)^e(1) * p(2)*e(2) *...* p(k)^e(k) -- se cumple que p(1) = 2 y, para cada i de 2 a k se cumple que -- 1+e(j) -- i-1 p(j) - 1 -- p(i) <= 1 + ∏ ---------------- -- j=1 p(j) - 1 esPractico3 :: Integer -> Bool esPractico3 1 = True esPractico3 n = x == 2 && and [p <= 1 + c | (p,c) <- zip bases cotas] where xss = factorizacion n (x:bases) = map fst xss cotas = scanl1 (*) [(p^(1+e)-1) `div` (p-1) | (p,e) <- xss] -- (factorizacion n) es la factorización de n. Por ejemplo, -- factorizacion 600 == [(2,3),(3,1),(5,2)] -- factorizacion 1400 == [(2,3),(5,2),(7,1)] factorizacion :: Integer -> [(Integer,Integer)] factorizacion n = [(head xs,genericLength xs) | xs <- group (primeFactors n)] -- Comparación de eficiencia -- ========================= -- λ> length [n | n <- [1..400], esPractico1 n] -- 92 -- (40.21 secs, 8,378,539,464 bytes) -- λ> length [n | n <- [1..400], esPractico2 n] -- 92 -- (8.29 secs, 1,109,669,760 bytes) -- λ> length [n | n <- [1..400], esPractico3 n] -- 92 -- (0.02 secs, 0 bytes) |
Basado en el artículo de Gaussianos Feliz Navidad y Feliz Año (número práctico) 2016.
Otras referencias
El grado perimetral de un número p es la cantidad de tres triángulos rectángulos de lados enteros cuyo perímetro es p. Por ejemplo, el grado perimetral de 120 es 3 ya que sólo hay 3 triángulos rectángulos de lados enteros cuyo perímetro es 120: {20,48,52}, {24,45,51} y {30,40,50}.
Definir la función
|
1 |
maxGradoPerimetral :: Int -> (Int,[Int]) |
tal que (maxGradoPerimetral n) es el par (m,ps) tal que m es el máximo grado perimetral de los números menores o iguales que n y ps son los perímetros, menores o iguales que n, cuyo grado perimetral es m. Por ejemplo,
|
1 2 3 4 5 6 7 8 9 10 11 |
maxGradoPerimetral 50 == (1,[12,24,30,36,40,48]) maxGradoPerimetral 100 == (2,[60,84,90]) maxGradoPerimetral 200 == (3,[120,168,180]) maxGradoPerimetral 400 == (4,[240,360]) maxGradoPerimetral 500 == (5,[420]) maxGradoPerimetral 750 == (6,[720]) maxGradoPerimetral 839 == (6,[720]) maxGradoPerimetral 840 == (8,[840]) maxGradoPerimetral 1500 == (8,[840,1260]) maxGradoPerimetral 2000 == (10,[1680]) maxGradoPerimetral 3000 == (12,[2520]) |
|
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 |
import Data.List import Data.Array (accumArray, assocs) -- 1ª solución -- -- =========== maxGradoPerimetral1 :: Int -> (Int,[Int]) maxGradoPerimetral1 p = (m,[x | (n,x) <- ts, n == m]) where ts = [(length (triangulos x),x) | x <- [1..p]] (m,_) = maximum ts -- (triangulos p) es el conjunto de triángulos rectángulos de perímetro -- p. Por ejemplo, -- triangulos 120 == [(20,48,52),(24,45,51),(30,40,50)] triangulos :: Int -> [(Int,Int,Int)] triangulos p = [(a,b,c) | a <- [1..q], b <- [a..q], let c = p-a-b, a*a+b*b == c*c] where q = p `div` 2 -- 2ª solución -- -- =========== maxGradoPerimetral2 :: Int -> (Int,[Int]) maxGradoPerimetral2 p = (m,[x | (n,x) <- ts, n == m]) where ts = [(n,x) | (x,n) <- numeroPerimetrosTriangulos p, n > 0] (m,_) = maximum ts -- (numeroPerimetrosTriangulos p) es la lista formado por los números de -- 1 a p y la cantidad de triángulos rectángulos enteros cuyo perímetro -- es dicho número. Por ejemplo, -- ghci> [(p,n) | (p,n) <- numeroPerimetrosTriangulos 70, n > 0] -- [(12,1),(24,1),(30,1),(36,1),(40,1),(48,1),(56,1),(60,2),(70,1)] numeroPerimetrosTriangulos :: Int -> [(Int,Int)] numeroPerimetrosTriangulos p = assocs (accumArray (\x _ -> 1+x) 0 (1,p) (perimetrosTriangulos p)) -- (perimetrosTriangulos p) es la lista formada por los perímetros y los -- lados de los triángulos rectángulos enteros cuyo perímetro es menor o -- igual que p. Por ejemplo, -- ghci> perimetrosTriangulos 70 -- [(12,(3,4,5)), (30,(5,12,13)),(24,(6,8,10)), (56,(7,24,25)), -- (40,(8,15,17)), (36,(9,12,15)),(60,(10,24,26)),(48,(12,16,20)), -- (60,(15,20,25)),(70,(20,21,29))] perimetrosTriangulos :: Int -> [(Int,(Int,Int,Int))] perimetrosTriangulos p = [(q,(a,b,c)) | a <- [1..p1], b <- [a..p1], esCuadrado (a*a+b*b), let c = raizCuadradaE (a*a+b*b), let q = a+b+c, q <= p] where p1 = p `div` 2 -- (esCuadrado n) se verifica si n es un cuadrado. Por ejemplo, -- esCuadrado 25 == True -- esCuadrado 27 == False esCuadrado :: Int -> Bool esCuadrado n = a*a == n where a = raizCuadradaE n -- (raizCuadradaE n) es la raíz cuadrada entera de n. Por ejemplo, -- raizCuadradaE 25 == 5 -- raizCuadradaE 27 == 5 -- raizCuadradaE 35 == 5 -- raizCuadradaE 36 == 6 raizCuadradaE :: Int -> Int raizCuadradaE = floor . sqrt . fromIntegral -- 3ª solución -- -- =========== maxGradoPerimetral3 :: Int -> (Int,[Int]) maxGradoPerimetral3 p = (m,[x | (n,x) <- ts, n == m]) where ts = [(n,x) | (x,n) <- numeroPerimetrosTriangulos2 p, n > 0] (m,_) = maximum ts -- (numeroPerimetrosTriangulos2 p) es la lista formado por los números de -- 1 a p y la cantidad de triángulos rectángulos enteros cuyo perímetro -- es dicho número. Por ejemplo, -- ghci> [(p,n) | (p,n) <- numeroPerimetrosTriangulos2 70, n > 0] -- [(12,1),(24,1),(30,1),(36,1),(40,1),(48,1),(56,1),(60,2),(70,1)] numeroPerimetrosTriangulos2 :: Int -> [(Int,Int)] numeroPerimetrosTriangulos2 p = [(head xs, length xs) | xs <- group (sort (perimetrosTriangulos2 p))] -- (perimetrosTriangulos2 p) es la lista formada por los perímetros de -- los triángulos rectángulos enteros cuyo perímetro es menor o igual -- que p. Por ejemplo, -- perimetrosTriangulos2 70 == [12,30,24,56,40,36,60,48,60,70] perimetrosTriangulos2 :: Int -> [Int] perimetrosTriangulos2 p = [q | a <- [1..p1], b <- [a..p1], esCuadrado (a*a+b*b), let c = raizCuadradaE (a*a+b*b), let q = a+b+c, q <= p] where p1 = p `div` 2 -- Comparación de eficiencia -- ========================= -- La comparación es -- ghci> maxGradoPerimetral1 1000 -- (8,[840]) -- (120.08 secs, 21116625136 bytes) -- ghci> maxGradoPerimetral2 1000 -- (8,[840]) -- (0.66 secs, 132959056 bytes) -- ghci> maxGradoPerimetral3 1000 -- (1000,[1]) -- (0.66 secs, 133443816 bytes) |
Dos enteros positivos a y b se dirán relacionados si poseen, exactamente, un factor primo en común. Por ejemplo, 12 y 20 están relacionados, pero 6 y 30 no lo están.
Definir la lista infinita
|
1 |
paresRel :: [(Int,Int)] |
tal que paresRel enumera todos los pares (a,b), con 1 ≤ a < b, tal que a y b están relacionados. Por ejemplo,
|
1 2 |
ghci> take 10 paresRel [(2,4),(2,6),(3,6),(4,6),(2,8),(4,8),(6,8),(3,9),(6,9),(2,10)] |
¿Qué lugar ocupa el par (51,111) en la lista infinita paresRel?
|
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 |
import Data.List (group, intersect, nub) import Data.Numbers.Primes (primeFactors) -- 1ª solución -- =========== paresRel1 :: [(Int,Int)] paresRel1 = [(a,b) | b <- [1..], a <- [1..b-1], relacionados a b] relacionados :: Int -> Int -> Bool relacionados a b = length (nub (primeFactors a `intersect` primeFactors b)) == 1 -- 2ª solución -- =========== paresRel2 :: [(Int,Int)] paresRel2 = [(x,y) | y <- [4..], x <- [2..y-2], rel x y] where rel x y = m /= 1 && all (== head ps) ps where m = gcd x y ps = primeFactors m -- 3ª solución -- =========== paresRel3 :: [(Int,Int)] paresRel3 = [(x,y) | y <- [2..], x <- [2..y-1], relacionados3 x y] relacionados3 :: Int -> Int -> Bool relacionados3 x y = length (group (primeFactors (gcd x y))) == 1 -- Comparación de eficiencia -- λ> paresRel1 !! 40000 -- (216,489) -- (3.19 secs, 1,825,423,056 bytes) -- λ> paresRel2 !! 40000 -- (216,489) -- (0.96 secs, 287,174,864 bytes) -- λ> paresRel3 !! 40000 -- (216,489) -- (0.70 secs, 264,137,928 bytes) -- Cálculo -- ======= -- El cálculo es -- ghci> 1 + length (takeWhile (/=(51,111)) paresRel1) -- 2016 |
Definir las funciones
|
1 2 |
agrupa :: Eq a => [a] -> [(a,Int)] expande :: [(a,Int)] -> [a] |
tales que
|
1 |
agrupa "aaabzzaa" == [('a',3),('b',1),('z',2),('a',2)] |
|
1 |
expande [('a',2),('b',3),('a',1)] == "aabbba" |
Comprobar con QuickCheck que dada una lista de enteros, si se la agrupa y después se expande se obtiene la lista inicial.
|
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 Test.QuickCheck -- Definiciones de agrupa -- ====================== -- 1ª definición (por recursión) agrupa :: Eq a => [a] -> [(a,Int)] agrupa xs = aux xs 1 where aux (x:y:zs) n | x == y = aux (y:zs) (n+1) | otherwise = (x,n) : aux (y:zs) 1 aux [x] n = [(x,n)] aux [] _ = [] -- 2ª definición (por recursión usando takeWhile): agrupa2 :: Eq a => [a] -> [(a,Int)] agrupa2 [] = [] agrupa2 (x:xs) = (x,1 + length (takeWhile (==x) xs)) : agrupa2 (dropWhile (==x) xs) -- 3ª definición (por comprensión usando group): agrupa3 :: Eq a => [a] -> [(a,Int)] agrupa3 xs = [(head ys,length ys) | ys <- group xs] -- 4ª definición (usando map y group): agrupa4 :: Eq a => [a] -> [(a,Int)] agrupa4 = map (\xs -> (head xs, length xs)) . group -- Definiciones de expande -- ======================= -- 1ª definición (por comprensión) expande :: [(a,Int)] -> [a] expande ps = concat [replicate k x | (x,k) <- ps] -- 2ª definición (por concatMap) expande2 :: [(a,Int)] -> [a] expande2 = concatMap (\(x,k) -> replicate k x) -- 3ª definición (por recursión) expande3 :: [(a,Int)] -> [a] expande3 [] = [] expande3 ((x,n):ps) = replicate n x ++ expande3 ps -- Comprobación -- ============ -- La propiedad es prop_expande_agrupa :: [Int] -> Bool prop_expande_agrupa xs = expande (agrupa xs) == xs -- La comprobación es -- ghci> quickCheck prop_expande_agrupa -- +++ OK, passed 100 tests. |
Definir la función
|
1 |
nMinimoCambios :: Ord a => [a] -> Int |
tal que (nMinimoCambios xs) es el menor número de elementos de xs que hay que cambiar para que todos sean iguales. Por ejemplo,
|
1 2 3 4 |
nMinimoCambios [3,5,3,7,9,6] == 4 nMinimoCambios [3,5,3,7,3,3] == 2 nMinimoCambios "Salamanca" == 5 nMinimoCambios (4 : [1..500000]) == 499999 |
En el primer ejemplo, los elementos que hay que cambiar son 5, 7, 9 y 6.
|
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 |
import Data.List (group, nub, sort) -- 1ª definición -- ============= nMinimoCambios1 :: Ord a => [a] -> Int nMinimoCambios1 xs = length xs - fst (last (sort (frecuencias xs))) -- (frecuencias xs) es la lista de los pares de los elementos de xs y el -- número de veces que ocurren en xs. Por ejemplo, -- frecuencias [3,5,3,7,9,6] == [(2,3),(1,5),(1,7),(1,9),(1,6)] -- frecuencias [3,5,3,7,5,5] == [(2,3),(3,5),(1,7)] frecuencias :: Ord a => [a] -> [(Int,a)] frecuencias xs = [(cuenta x xs,x) | x <- nub xs] -- (cuenta x ys) es el número de veces que ocurre x en ys. Por ejemplo, -- cuenta 3 [3,5,3,7,9,6] == 2 cuenta :: Ord a => a -> [a] -> Int cuenta x ys = length [y | y <- ys, y == x] -- 2ª definición -- ============= nMinimoCambios2 :: Ord a => [a] -> Int nMinimoCambios2 xs = length xs - fst (last (sort (frecuencias2 xs))) -- (frecuencias2 xs) es la lista de los pares de los elementos de xs y el -- número de veces que ocurren en xs. Por ejemplo, -- frecuencias2 [3,5,3,7,9,6] == [(2,3),(1,5),(1,7),(1,9),(1,6)] -- frecuencias2 [3,5,3,7,5,5] == [(2,3),(3,5),(1,7)] frecuencias2 :: Ord a => [a] -> [(Int,a)] frecuencias2 xs = [(1 + length ys, y) | (y:ys) <- group (sort xs)] -- 3ª definición -- ============= nMinimoCambios3 :: Ord a => [a] -> Int nMinimoCambios3 xs = sum ys - maximum ys where ys = [length ys | ys <- group (sort xs)] |
La sucesión de los números triangulares se obtiene sumando los números naturales.
Así, el 7º número triangular es
|
1 |
1 + 2 + 3 + 4 + 5 + 6 + 7 = 28. |
Los primeros 10 números triangulares son
|
1 |
1, 3, 6, 10, 15, 21, 28, 36, 45, 55, ... |
Los divisores de los primeros 7 números triangulares son:
|
1 2 3 4 5 6 7 |
1: 1 3: 1,3 6: 1,2,3,6 10: 1,2,5,10 15: 1,3,5,15 21: 1,3,7,21 28: 1,2,4,7,14,28 |
Como se puede observar, 28 es el menor número triangular con más de 5 divisores.
Definir la función
|
1 |
menorTriangularConAlMenosNDivisores :: Int -> Integer |
tal que (menorTriangularConAlMenosNDivisores n) es el menor número triangular que tiene al menos n divisores. Por ejemplo,
|
1 2 3 |
menorTriangularConAlMenosNDivisores 5 == 28 menorTriangularConAlMenosNDivisores 50 == 25200 menorTriangularConAlMenosNDivisores 500 == 76576500 |
|
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 |
import Data.List (group) import Data.Numbers.Primes (primes,primeFactors) -- 1ª definición -- ============= menorTriangularConAlMenosNDivisores1 :: Int -> Integer menorTriangularConAlMenosNDivisores1 n = head [x | x <- triangulares, nDivisores x >= n] -- triangulares es la sucesión de los números triangulares. Por ejemplo, -- take 10 triangulares == [1,3,6,10,15,21,28,36,45,55] triangulares :: [Integer] triangulares = scanl (+) 1 [2..] -- (nDivisores x) es el número de divisores de x. Por ejemplo, -- nDivisores 28 == 6 nDivisores :: Integer -> Int nDivisores x = 1 + length [y | y <- [1..x `div` 2], mod x y == 0] -- 2ª solución -- =========== menorTriangularConAlMenosNDivisores2 :: Int -> Integer menorTriangularConAlMenosNDivisores2 n = head [x | x <- triangulares, nDivisores2 x >= n] -- (nDivisores2 x) es el número de divisores de x. Por ejemplo, -- nDivisores2 28 == 6 nDivisores2 :: Integer -> Int nDivisores2 n = product [1 + length xs | xs <- group (factoresPrimos n)] -- (factoresPrimos n) es la lista de los factores primos de n. Por -- ejemplo, -- factoresPrimos 28 == [2,2,7] factoresPrimos :: Integer -> [Integer] factoresPrimos n = aux n primos where aux n (p:ps) | p*p > n = [n] | n `mod` p == 0 = p : aux (n `div` p) (p:ps) | otherwise = aux n ps -- primos es la lista de los números primos. Por ejemplo, -- take 10 primos == [2,3,5,7,11,13,17,19,23,29] primos :: [Integer] primos = 2 : filter ((==1) . length . factoresPrimos) [3,5..] -- 3ª solución (usando primes) -- =========================== menorTriangularConAlMenosNDivisores3 :: Int -> Integer menorTriangularConAlMenosNDivisores3 n = head [x | x <- triangulares, nDivisores3 x >= n] -- (nDivisores3 x) es el número de divisores de x. Por ejemplo, -- nDivisores3 28 == 6 nDivisores3 :: Integer -> Int nDivisores3 n = product [1 + length xs | xs <- group (factoresPrimos3 n)] -- (factoresPrimos3 n) es la lista de los factores primos de n. Por -- ejemplo, -- factoresPrimos3 28 == [2,2,7] factoresPrimos3 n = aux n primes where aux n (p:ps) | p*p > n = [n] | n `mod` p == 0 = p : aux (n `div` p) (p:ps) | otherwise = aux n ps -- 4ª solución (usando primeFactors) -- ================================= menorTriangularConAlMenosNDivisores4 :: Int -> Integer menorTriangularConAlMenosNDivisores4 n = head [x | x <- triangulares, nDivisores4 x >= n] -- (nDivisores4 x) es el número de divisores de x. Por ejemplo, -- nDivisores4 28 == 6 nDivisores4 :: Integer -> Int nDivisores4 n = product [1 + length xs | xs <- group (primeFactors n)] -- --------------------------------------------------------------------- -- § Comparación de eficiencia -- -- --------------------------------------------------------------------- -- La comparación es -- ghci> menorTriangularConAlMenosNDivisores1 50 -- 25200 -- (1.25 secs, 200236512 bytes) -- -- ghci> menorTriangularConAlMenosNDivisores2 50 -- 25200 -- (0.02 secs, 4199904 bytes) -- -- ghci> menorTriangularConAlMenosNDivisores3 50 -- 25200 -- (0.03 secs, 6265128 bytes) -- -- ghci> menorTriangularConAlMenosNDivisores4 50 -- 25200 -- (0.01 secs, 5753048 bytes) |
Definir la función
|
1 |
masFrecuentes :: Ord a => Int -> [a] -> [(Int,a)] |
tal que (masFrecuentes n xs) es la lista de los pares formados por los elementos de xs que aparecen más veces junto con el número de veces que aparecen. Por ejemplo,
|
1 2 3 4 5 6 |
ghci> masFrecuentes 2 "trianera" [(2,'r'),(2,'a')] ghci> masFrecuentes 2 "interdisciplinariedad" [(5,'i'),(3,'d')] ghci> masFrecuentes 3 (show (product [1..10000])) [(5803,'0'),(3416,'2'),(3341,'4')] |
|
1 2 3 4 5 |
import Data.List (group, sort) masFrecuentes :: Ord a => Int -> [a] -> [(Int,a)] masFrecuentes n = take n . reverse . sort . cuenta . group . sort where cuenta xss = [(length xs,head xs) | xs <- xss] |
|
1 2 3 4 5 6 7 |
-- Definir la función -- sinConsecutivosRepetidos :: Eq a => [a] -> [a] -- tal que (sinConsecutivosRepetidos xs) es la lista obtenida a partir -- de xs de forma que si hay dos o más elementos idénticos consecutivos, -- borra las repeticiones y deja sólo el primer elemento. Por ejemplo, -- ghci> sinConsecutivosRepetidos "eesssooo essss toodddooo" -- "eso es todo" |
|
1 2 3 4 5 6 7 8 9 10 11 |
import Data.List (group) -- 1ª solución (por comprensión): sinConsecutivosRepetidos :: Eq a => [a] -> [a] sinConsecutivosRepetidos xs = [x | (x:_) <- group xs] -- 2ª solución (por recursión): sinConsecutivosRepetidos2 :: Eq a => [a] -> [a] sinConsecutivosRepetidos2 [] = [] sinConsecutivosRepetidos2 (x:xs) = x : sinConsecutivosRepetidos2 (dropWhile (==x) xs) |
|
1 2 3 4 5 6 7 8 |
-- Una llanura de longitud n de una lista xs es una sublista de xs -- formada por n elementos iguales. -- -- Definir la función -- llanuras :: Eq a => Int -> [a] -> [[a]] -- tal que (llanuras n xs) es la lista de las llanuras de xs que tienen -- n elementos como mínimo. Por ejemplo, -- llanuras 3 "aabbbcddddffxffxx" == ["bbb","dddd"] |
|
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 |
import Data.List (group) import Test.QuickCheck -- 1ª definición (por comprensión): llanuras :: Eq a => Int -> [a] -> [[a]] llanuras n xs = [ys | ys <- group xs, length ys >= n] -- 2ª definición (por recursión con takeWhile y dropWhile): llanuras2 :: Eq a => Int -> [a] -> [[a]] llanuras2 _ [] = [] llanuras2 n xs@(x:_) | length ys >= n = ys : llanuras2 n (dropWhile (x==) xs) | otherwise = llanuras2 n (dropWhile (x==) xs) where ys = takeWhile (x==) xs -- 3ª definición (por recursión con span): llanuras3 :: Eq a => Int -> [a] -> [[a]] llanuras3 _ [] = [] llanuras3 n xs@(x:_) | length ys >= n = ys : llanuras3 n zs | otherwise = llanuras3 n zs where (ys,zs) = span (x==) xs -- 4ª definición (por recursión con span): llanuras4 :: Eq a => Int -> [a] -> [[a]] llanuras4 n = aux where aux [] = [] aux xs@(x:_) | length ys >= n = ys : llanuras4 n zs | otherwise = llanuras4 n zs where (ys,zs) = span (x==) xs -- --------------------------------------------------------------------- -- § Verificación -- -- --------------------------------------------------------------------- -- Las definiciones son equivalentes prop_equivalencia :: Int -> [Int] -> Bool prop_equivalencia n xs = llanuras2 n xs == ys && llanuras3 n xs == ys where ys = llanuras n xs -- La comprobación es -- ghci> quickCheck prop_equivalencia -- +++ OK, passed 100 tests. |
Esté ejercicio está basado en el problema Llanura de números iguales con longitud igual a n propuesto Solveet!