Esta semana he publicado en Exercitium las soluciones de los siguientes problemas:
- 1. Ceros finales del factorial
- 2. Unión e intersección general de conjuntos
- 3. Intersecciones parciales
- 4. Mayor semiprimo menor que n
- 5. Particiones en k subconjuntos
A continuación se muestran las soluciones.
1. Ceros finales del factorial
Definir la función
cerosDelFactorial :: Integer -> Integer |
tal que (cerosDelFactorial n) es el número de ceros en que termina el factorial de n. Por ejemplo,
cerosDelFactorial 24 == 4 cerosDelFactorial 25 == 6 length (show (cerosDelFactorial (10^70000))) == 70000 |
Soluciones
import Data.List (genericLength) import Test.QuickCheck (Positive (Positive), quickCheck) -- 1ª solución -- =========== cerosDelFactorial1 :: Integer -> Integer cerosDelFactorial1 n = ceros (factorial n) -- (factorial n) es el factorial n. Por ejemplo, -- factorial 3 == 6 factorial :: Integer -> Integer factorial n = product [1..n] -- (ceros n) es el número de ceros en los que termina el número n. Por -- ejemplo, -- ceros 320000 == 4 ceros :: Integer -> Integer ceros n | rem n 10 /= 0 = 0 | otherwise = 1 + ceros (div n 10) -- 2ª solución -- =========== cerosDelFactorial2 :: Integer -> Integer cerosDelFactorial2 = ceros2 . factorial ceros2 :: Integer -> Integer ceros2 n = genericLength (takeWhile (=='0') (reverse (show n))) -- 3ª solución -- ============= cerosDelFactorial3 :: Integer -> Integer cerosDelFactorial3 n | n < 5 = 0 | otherwise = m + cerosDelFactorial3 m where m = n `div` 5 -- Comprobación de equivalencia -- ============================ -- La propiedad es prop_cerosDelFactorial :: Positive Integer -> Bool prop_cerosDelFactorial (Positive n) = all (== cerosDelFactorial1 n) [cerosDelFactorial2 n, cerosDelFactorial3 n] -- La comprobación es -- λ> quickCheck prop_cerosDelFactorial -- +++ OK, passed 100 tests. -- Comparación de eficiencia -- ========================= -- La comparación es -- λ> cerosDelFactorial1 (4*10^4) -- 9998 -- (1.93 secs, 2,296,317,904 bytes) -- λ> cerosDelFactorial2 (4*10^4) -- 9998 -- (1.57 secs, 1,636,242,040 bytes) -- λ> cerosDelFactorial3 (4*10^4) -- 9998 -- (0.02 secs, 527,584 bytes) |
El código se encuentra en GitHub.
2. Unión e intersección general de conjuntos
Definir las funciones
unionGeneral :: Eq a => [[a]] -> [a] interseccionGeneral :: Eq a => [[a]] -> [a] |
tales que
- (unionGeneral xs) es la unión de los conjuntos de la lista de conjuntos xs (es decir, el conjunto de los elementos que pertenecen a alguno de los elementos de xs). Por ejemplo,
unionGeneral [] == []
unionGeneral [[1]] == [1]
unionGeneral [[1],[1,2],[2,3]] == [1,2,3]
unionGeneral ([[x] | x <- [1..9]]) == [1,2,3,4,5,6,7,8,9] |
- (interseccionGeneral xs) es la intersección de los conjuntos de la lista de conjuntos xs (es decir, el conjunto de los elementos que pertenecen a todos los elementos de xs). Por ejemplo,
interseccionGeneral [[1]] == [1]
interseccionGeneral [[2],[1,2],[2,3]] == [2]
interseccionGeneral [[2,7,5],[1,5,2],[5,2,3]] == [2,5]
interseccionGeneral ([[x] | x <- [1..9]]) == []
interseccionGeneral (replicate (10^6) [1..5]) == [1,2,3,4,5] |
Soluciones
import Data.List (foldl', foldl1', intersect, nub, union) import Test.QuickCheck (NonEmptyList (NonEmpty), quickCheck) -- 1ª definición de unionGeneral -- ============================= unionGeneral1 :: Eq a => [[a]] -> [a] unionGeneral1 [] = [] unionGeneral1 (x:xs) = x `union` unionGeneral1 xs -- 2ª definición de unionGeneral -- ============================= unionGeneral2 :: Eq a => [[a]] -> [a] unionGeneral2 = foldr union [] -- 3ª definición de unionGeneral -- ============================= unionGeneral3 :: Eq a => [[a]] -> [a] unionGeneral3 = foldl' union [] -- Comprobación de equivalencia de unionGeneral -- ============================================ -- La propiedad es prop_unionGeneral :: [[Int]] -> Bool prop_unionGeneral xss = all (== unionGeneral1 xss') [unionGeneral2 xss', unionGeneral3 xss'] where xss' = nub (map nub xss) -- La comprobación es -- λ> quickCheck prop_unionGeneral -- +++ OK, passed 100 tests. -- (0.85 secs, 1,017,807,600 bytes) -- Comparación de eficiencia de unionGeneral -- ========================================= -- La comparación es -- λ> length (unionGeneral1 ([[x] | x <- [1..10^3]])) -- 1000 -- (1.56 secs, 107,478,456 bytes) -- λ> length (unionGeneral2 ([[x] | x <- [1..10^3]])) -- 1000 -- (1.50 secs, 107,406,560 bytes) -- λ> length (unionGeneral3 ([[x] | x <- [1..10^3]])) -- 1000 -- (0.07 secs, 92,874,024 bytes) -- 1ª definición de interseccionGeneral -- ==================================== interseccionGeneral1 :: Eq a => [[a]] -> [a] interseccionGeneral1 [x] = x interseccionGeneral1 (x:xs) = x `intersect` interseccionGeneral1 xs -- 2ª definición de interseccionGeneral -- ==================================== interseccionGeneral2 :: Eq a => [[a]] -> [a] interseccionGeneral2 = foldr1 intersect -- 3ª definición de interseccionGeneral -- ==================================== interseccionGeneral3 :: Eq a => [[a]] -> [a] interseccionGeneral3 = foldl1' intersect -- Comprobación de equivalencia -- ============================ -- La propiedad es prop_interseccionGeneral :: NonEmptyList [Int] -> Bool prop_interseccionGeneral (NonEmpty xss) = all (== interseccionGeneral1 xss') [interseccionGeneral2 xss', interseccionGeneral3 xss'] where xss' = nub (map nub xss) -- La comprobación es -- λ> quickCheck prop_interseccionGeneral -- +++ OK, passed 100 tests. -- Comparación de eficiencia -- ========================= -- La comparación es -- λ> interseccionGeneral1 (replicate (10^6) [1..5]) -- [1,2,3,4,5] -- (2.02 secs, 1,173,618,400 bytes) -- λ> interseccionGeneral2 (replicate (10^6) [1..5]) -- [1,2,3,4,5] -- (1.83 secs, 1,092,120,224 bytes) -- λ> interseccionGeneral3 (replicate (10^6) [1..5]) -- [1,2,3,4,5] -- (1.33 secs, 985,896,136 bytes) |
El código se encuentra en GitHub.
3. Intersecciones parciales
Definir la función
interseccionParcial :: Ord a => Int -> [[a]] -> [a] |
tal que (interseccionParcial n xss) es la lista de los elementos que pertenecen al menos a n conjuntos de xss. Por ejemplo,
interseccionParcial 1 [[3,4],[4,5,9],[5,4,7]] == [3,4,5,9,7] interseccionParcial 2 [[3,4],[4,5,9],[5,4,7]] == [4,5] interseccionParcial 3 [[3,4],[4,5,9],[5,4,7]] == [4] interseccionParcial 4 [[3,4],[4,5,9],[5,4,7]] == [] |
Soluciones
import Data.List (foldl', nub, union, sort) import Test.QuickCheck -- 1ª solución -- =========== interseccionParcial1 :: Ord a => Int -> [[a]] -> [a] interseccionParcial1 n xss = [x | x <- sort (elementos xss) , pertenecenAlMenos n xss x] elementos :: Ord a => [[a]] -> [a] elementos [] = [] elementos (xs:xss) = xs `union` elementos xss pertenecenAlMenos :: Ord a => Int -> [[a]] -> a -> Bool pertenecenAlMenos n xss x = length [xs | xs <- xss, x `elem` xs] >= n -- 2ª solución -- =========== interseccionParcial2 :: Ord a => Int -> [[a]] -> [a] interseccionParcial2 n xss = [x | x <- sort (elementos2 xss) , pertenecenAlMenos2 n xss x] elementos2 :: Ord a => [[a]] -> [a] elementos2 = foldl' union [] pertenecenAlMenos2 :: Ord a => Int -> [[a]] -> a -> Bool pertenecenAlMenos2 n xss x = length (filter (x `elem`) xss) >= n -- 3ª solución -- =========== interseccionParcial3 :: Ord a => Int -> [[a]] -> [a] interseccionParcial3 n xss = [x | x <- sort (nub (concat xss)) , length [xs | xs <- xss, x `elem` xs] >= n] -- Comprobación de equivalencia -- ============================ -- La propiedad es prop_interseccionParcial :: Positive Int -> [[Int]] -> Bool prop_interseccionParcial (Positive n) xss = all (== interseccionParcial1 n yss) [interseccionParcial2 n yss, interseccionParcial3 n yss] where yss = map nub xss -- La comprobación es -- λ> quickCheck prop_interseccionParcial -- +++ OK, passed 100 tests. |
El código se encuentra en GitHub.
4. Mayor semiprimo menor que n
Un número semiprimo es un número natural es producto de dos números primos no necesariamente distintos. Por ejemplo, 26 es semiprimo (porque 26 = 2·13) y 49 también lo es (porque 49 = 7·7).
Definir la función
mayorSemiprimoMenor :: Integer -> Integer |
tal que (mayorSemiprimoMenor n) es el mayor semiprimo menor que n (suponiendo que n > 4). Por ejemplo,
mayorSemiprimoMenor 27 == 26 mayorSemiprimoMenor 50 == 49 mayorSemiprimoMenor 49 == 46 mayorSemiprimoMenor (10^15) == 999999999999998 |
Soluciones
import Data.Numbers.Primes (primeFactors, isPrime, primes) import Test.QuickCheck -- 1ª solución -- =========== mayorSemiprimoMenor1 :: Integer -> Integer mayorSemiprimoMenor1 n = head [x | x <- [n-1,n-2..2], semiPrimo x] semiPrimo :: Integer -> Bool semiPrimo n = not (null [x | x <- [n,n-1..2], primo x, n `mod` x == 0, primo (n `div` x)]) primo :: Integer -> Bool primo n = [x | x <- [1..n], n `mod` x == 0] == [1,n] -- 2ª solución -- =========== mayorSemiprimoMenor2 :: Integer -> Integer mayorSemiprimoMenor2 n = head [x | x <- [n-1,n-2..2], semiPrimo2 x] semiPrimo2 :: Integer -> Bool semiPrimo2 n = not (null [x | x <- [n-1,n-2..2], isPrime x, n `mod` x == 0, isPrime (n `div` x)]) -- 3ª solución -- =========== mayorSemiprimoMenor3 :: Integer -> Integer mayorSemiprimoMenor3 n = head [x | x <- [n-1,n-2..2], semiPrimo3 x] semiPrimo3 :: Integer -> Bool semiPrimo3 n = not (null [x | x <- reverse (takeWhile (<n) primes), n `mod` x == 0, isPrime (n `div` x)]) -- 4ª solución -- =========== mayorSemiprimoMenor4 :: Integer -> Integer mayorSemiprimoMenor4 n = head [ p | p <- [n-1,n-2..2] , (length . primeFactors) p == 2] -- 5ª solución -- =========== mayorSemiprimoMenor5 :: Integer -> Integer mayorSemiprimoMenor5 n | semiPrimo5 (n-1) = n-1 | otherwise = mayorSemiprimoMenor5 (n-1) semiPrimo5 :: Integer -> Bool semiPrimo5 x = length (primeFactors x) == 2 -- Comprobación de equivalencia -- ============================ -- La propiedad es prop_mayorSemiprimoMenor :: Integer -> Property prop_mayorSemiprimoMenor n = n > 4 ==> all (== mayorSemiprimoMenor1 n) [mayorSemiprimoMenor2 n, mayorSemiprimoMenor3 n, mayorSemiprimoMenor4 n, mayorSemiprimoMenor5 n] -- La comprobación es -- λ> quickCheck prop_mayorSemiprimoMenor -- +++ OK, passed 100 tests; 353 discarded. -- Comparación de eficiencia -- ========================= -- La comparación es -- λ> mayorSemiprimoMenor1 5000 -- 4997 -- (1.92 secs, 945,507,880 bytes) -- λ> mayorSemiprimoMenor2 5000 -- 4997 -- (0.05 secs, 123,031,264 bytes) -- λ> mayorSemiprimoMenor3 5000 -- 4997 -- (0.01 secs, 5,865,120 bytes) -- λ> mayorSemiprimoMenor4 5000 -- 4997 -- (0.00 secs, 593,528 bytes) -- λ> mayorSemiprimoMenor5 5000 -- 4997 -- (0.00 secs, 593,200 bytes) -- -- λ> mayorSemiprimoMenor3 (3*10^6) -- 2999995 -- (2.34 secs, 6,713,620,000 bytes) -- λ> mayorSemiprimoMenor4 (2*10^6) -- 1999997 -- (0.01 secs, 728,936 bytes) -- λ> mayorSemiprimoMenor5 (2*10^6) -- 1999997 -- (0.01 secs, 728,608 bytes) |
El código se encuentra en GitHub.
5. Particiones en k subconjuntos
Definir la función
particiones :: [a] -> Int -> [[[a]]] |
tal que (particiones xs k) es la lista de las particiones de xs en k subconjuntos disjuntos. Por ejemplo,
λ> particiones [2,3,6] 2
[[[2],[3,6]],[[2,3],[6]],[[3],[2,6]]]
λ> particiones [2,3,6] 3
[[[2],[3],[6]]]
λ> particiones [4,2,3,6] 3
[[[4],[2],[3,6]],[[4],[2,3],[6]],[[4],[3],[2,6]],
[[4,2],[3],[6]],[[2],[4,3],[6]],[[2],[3],[4,6]]]
λ> particiones [4,2,3,6] 1
[[[4,2,3,6]]]
λ> particiones [4,2,3,6] 4
[[[4],[2],[3],[6]]] |
Soluciones
import Data.List (nub, sort) import Data.Array (Array, (!), array, listArray) import Test.QuickCheck (Positive (Positive), quickCheckWith) -- 1ª solución -- =========== particiones1 :: [a] -> Int -> [[[a]]] particiones1 [] _ = [] particiones1 _ 0 = [] particiones1 xs 1 = [[xs]] particiones1 (x:xs) k = [[x]:ys | ys <- particiones1 xs (k-1)] ++ concat [inserta x ys | ys <- particiones1 xs k] -- (inserta x yss) es la lista obtenida insertando x en cada uno de los -- conjuntos de yss. Por ejemplo, -- inserta 4 [[3],[2,5]] == [[[4,3],[2,5]],[[3],[4,2,5]]] inserta :: a -> [[a]] -> [[[a]]] inserta _ [] = [] inserta x (ys:yss) = ((x:ys):yss) : [ys:zss | zss <- inserta x yss] -- 2ª solución -- =========== particiones2 :: [a] -> Int -> [[[a]]] particiones2 [] _ = [] particiones2 _ 0 = [] particiones2 xs 1 = [[xs]] particiones2 (x:xs) k = map ([x]:) (particiones2 xs (k-1)) ++ concatMap (inserta x) (particiones2 xs k) -- 3ª solución -- =========== particiones3 :: [a] -> Int -> [[[a]]] particiones3 xs k = matrizParticiones xs k ! (length xs, k) matrizParticiones :: [a] -> Int -> Array (Int,Int) [[[a]]] matrizParticiones xs k = q where q = array ((0,0),(n,k)) [((i,j), f i j) | i <- [0..n], j <- [0..k]] n = length xs v = listArray (1,n) xs f _ 0 = [] f 0 _ = [] f m 1 = [[take m xs]] f i j | i == j = [[[x] | x <- take i xs]] | otherwise = map ([v!i] :) (q!(i-1,j-1)) ++ concatMap (inserta (v!i)) (q!(i-1,j)) -- Comprobación de equivalencia -- ============================ -- La propiedad es prop_particiones :: [Int] -> Positive Int -> Bool prop_particiones xs (Positive k) = all (iguales (particiones1 xs' k)) [particiones2 xs' k, particiones3 xs' k] where xs' = nub xs iguales xss yss = sort (map sort [map sort x | x <- xss]) == sort (map sort [map sort y | y <- yss]) -- La comprobación es -- λ> quickCheckWith (stdArgs {maxSize=10}) prop_particiones -- +++ OK, passed 100 tests. -- Comparación de eficiencia -- ========================= -- La comparación es -- λ> length (particiones1 [1..12] 6) -- 1323652 -- (1.33 secs, 1,152,945,584 bytes) -- λ> length (particiones2 [1..12] 6) -- 1323652 -- (1.07 secs, 1,104,960,360 bytes) -- λ> length (particiones3 [1..12] 6) -- 1323652 -- (1.68 secs, 1,047,004,368 bytes) |
El código se encuentra en GitHub.