PFH: La semana en Exercitium (del 2 al 6 de mayo de 2022)
Esta semana he publicado en Exercitium las soluciones de los siguientes problemas:
A continuación se muestran las soluciones.
1. Clausura de un conjunto respecto de una función
Un conjunto A está cerrado respecto de una función f si para elemento x de A se tiene que f(x) pertenece a A. La clausura de un conjunto B respecto de una función f es el menor conjunto A que contiene a B y es cerrado respecto de f. Por ejemplo, la clausura de {0,1,2] respecto del opuesto es {-2,-1,0,1,2}.
Definir la función
|
1 |
clausura :: Ord a => (a -> a) -> [a] -> [a] |
tal que (clausura f xs) es la clausura de xs respecto de f. Por ejemplo,
|
1 2 3 |
clausura (\x -> -x) [0,1,2] == [-2,-1,0,1,2] clausura (\x -> (x+1) `mod` 5) [0] == [0,1,2,3,4] length (clausura (\x -> (x+1) `mod` (10^6)) [0]) == 1000000 |
Soluciones
|
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 |
module Clausura where import Data.List ((\\), nub, sort, union) import Test.QuickCheck.HigherOrder (quickCheck') import qualified Data.Set as S (Set, difference, fromList, map, null, toList, union) -- 1ª solución -- =========== clausura1 :: Ord a => (a -> a) -> [a] -> [a] clausura1 f xs | esCerrado f xs = sort xs | otherwise = clausura1 f (expansion f xs) -- (esCerrado f xs) se verifica si al aplicar f a cualquier elemento de -- xs se obtiene un elemento de xs. Por ejemplo, -- λ> esCerrado (\x -> -x) [0,1,2] -- False -- λ> esCerrado (\x -> -x) [0,1,2,-2,-1] -- True esCerrado :: Ord a => (a -> a) -> [a] -> Bool esCerrado f xs = all (`elem` xs) (map f xs) -- (expansion f xs) es la lista (sin repeticiones) obtenidas añadiéndole -- a xs el resulta de aplicar f a sus elementos. Por ejemplo, -- expansion (\x -> -x) [0,1,2] == [0,1,2,-1,-2] expansion :: Ord a => (a -> a) -> [a] -> [a] expansion f xs = xs `union` map f xs -- 2ª solución -- =========== clausura2 :: Ord a => (a -> a) -> [a] -> [a] clausura2 f xs = sort (until (esCerrado f) (expansion f) xs) -- 3ª solución -- =========== clausura3 :: Ord a => (a -> a) -> [a] -> [a] clausura3 f xs = aux xs xs where aux ys vs | null ns = sort vs | otherwise = aux ns (vs ++ ns) where ns = nub (map f ys) \\ vs -- 4ª solución -- =========== clausura4 :: Ord a => (a -> a) -> [a] -> [a] clausura4 f xs = S.toList (clausura4' f (S.fromList xs)) clausura4' :: Ord a => (a -> a) -> S.Set a -> S.Set a clausura4' f xs = aux xs xs where aux ys vs | S.null ns = vs | otherwise = aux ns (vs `S.union` ns) where ns = S.map f ys `S.difference` vs -- Comprobación de equivalencia -- ============================ -- La propiedad es prop_clausura :: (Int -> Int) -> [Int] -> Bool prop_clausura f xs = all (== clausura1 f xs') [ clausura2 f xs' , clausura3 f xs' , clausura4 f xs' ] where xs' = sort (nub xs) -- La comprobación es -- λ> quickCheck' prop_clausura -- +++ OK, passed 100 tests. -- Comparación de eficiencia -- ========================= -- La comparación es -- λ> length (clausura1 (\x -> (x+1) `mod` 800) [0]) -- 800 -- (1.95 secs, 213,481,560 bytes) -- λ> length (clausura2 (\x -> (x+1) `mod` 800) [0]) -- 800 -- (1.96 secs, 213,372,824 bytes) -- λ> length (clausura3 (\x -> (x+1) `mod` 800) [0]) -- 800 -- (0.03 secs, 42,055,128 bytes) -- λ> length (clausura4 (\x -> (x+1) `mod` 800) [0]) -- 800 -- (0.01 secs, 1,779,768 bytes) -- -- λ> length (clausura3 (\x -> (x+1) `mod` (10^4)) [0]) -- 10000 -- (2.50 secs, 8,080,105,816 bytes) -- λ> length (clausura4 (\x -> (x+1) `mod` (10^4)) [0]) -- 10000 -- (0.05 secs, 27,186,920 bytes) |
El código se encuentra en GitHub.
La elaboración de las soluciones se describe en el siguiente vídeo
2. Puntos en regiones rectangulares
Los puntos se puede representar mediante pares de números
|
1 |
type Punto = (Int,Int) |
y las regiones rectangulares mediante el siguiente tipo de dato
|
1 2 3 4 |
data Region = Rectangulo Punto Punto | Union Region Region | Diferencia Region Region deriving (Eq, Show) |
donde
(Rectangulo p1 p2)es la región formada por un rectángulo cuyo vértice superior izquierdo esp1y su vértice inferior derecho esp2.(Union r1 r2)es la región cuyos puntos pertenecen a alguna de las regionesr1yr2.(Diferencia r1 r2)es la región cuyos puntos pertenecen a la regiónr1pero no pertenecen a lar2.
Definir la función
|
1 |
enRegion :: Punto -> Region -> Bool |
tal que (enRegion p r) se verifica si el punto p pertenece a la región r. Por ejemplo, usando las regiones definidas por
|
1 2 3 4 |
r0021, r3051, r4162 :: Region r0021 = Rectangulo (0,0) (2,1) r3051 = Rectangulo (3,0) (5,1) r4162 = Rectangulo (4,1) (6,2) |
se tiene
|
1 2 3 4 5 6 7 8 9 |
enRegion (1,0) r0021 == True enRegion (3,0) r0021 == False enRegion (1,1) (Union r0021 r3051) == True enRegion (4,0) (Union r0021 r3051) == True enRegion (4,2) (Union r0021 r3051) == False enRegion (3,1) (Diferencia r3051 r4162) == True enRegion (4,1) (Diferencia r3051 r4162) == False enRegion (4,2) (Diferencia r3051 r4162) == False enRegion (4,2) (Union (Diferencia r3051 r4162) r4162) == True |
Comprobar con QuickCheck que si el punto p está en la región r1, entonces, para cualquier región r2, p está en (Union r1 r2) y en (Union r2 r1), pero no está en (Diferencia r2 r1).
Soluciones
|
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 |
module Puntos_en_regiones_rectangulares where import Test.QuickCheck (Arbitrary, Gen, Property, (==>), arbitrary, oneof, sized, generate, quickCheck, quickCheckWith, stdArgs, Args(maxDiscardRatio)) type Punto = (Int,Int) data Region = Rectangulo Punto Punto | Union Region Region | Diferencia Region Region deriving (Eq, Show) r0021, r3051, r4162 :: Region r0021 = Rectangulo (0,0) (2,1) r3051 = Rectangulo (3,0) (5,1) r4162 = Rectangulo (4,1) (6,2) enRegion :: Punto -> Region -> Bool enRegion (x,y) (Rectangulo (x1,y1) (x2,y2)) = x1 <= x && x <= x2 && y1 <= y && y <= y2 enRegion p (Union r1 r2) = enRegion p r1 || enRegion p r2 enRegion p (Diferencia r1 r2) = enRegion p r1 && not (enRegion p r2) -- (regionArbitraria n) es un generador de regiones arbitrarias de orden -- n. Por ejemplo, -- λ> generate (regionArbitraria 2) -- Rectangulo (30,-26) (-2,-8) -- λ> generate (regionArbitraria 2) -- Union (Union (Rectangulo (-2,-5) (6,1)) (Rectangulo(3,7) (11,15))) -- (Diferencia (Rectangulo (9,8) (-2,6)) (Rectangulo (-2,2) (7,8))) regionArbitraria :: Int -> Gen Region regionArbitraria 0 = Rectangulo <$> arbitrary <*> arbitrary regionArbitraria n = oneof [Rectangulo <$> arbitrary <*> arbitrary, Union <$> subregion <*> subregion, Diferencia <$> subregion <*> subregion] where subregion = regionArbitraria (n `div` 2) -- Region está contenida en Arbitrary instance Arbitrary Region where arbitrary = sized regionArbitraria -- La propiedad es prop_enRegion :: Punto -> Region -> Region -> Property prop_enRegion p r1 r2 = enRegion p r1 ==> (enRegion p (Union r1 r2) && enRegion p (Union r2 r1) && not (enRegion p (Diferencia r2 r1))) -- La comprobación es -- λ> quickCheck prop_enRegion -- *** Gave up! Passed only 78 tests; 1000 discarded tests. -- -- λ> quickCheckWith (stdArgs {maxDiscardRatio=20}) prop_enRegion -- +++ OK, passed 100 tests. |
El código se encuentra en GitHub.
La elaboración de las soluciones se describe en el siguiente vídeo