La semana en Exercitium (del 18 al 23 de abril)
Esta semana he publicado en Exercitium las soluciones de los siguientes problemas:
A continuación se muestran las soluciones.
1. Emparejamiento de árboles
Los árboles se pueden representar mediante el siguiente tipo de datos
|
1 2 |
data Arbol a = N a [Arbol a] deriving (Show, Eq) |
Por ejemplo, los árboles
|
1 2 3 4 5 6 |
1 3 / \ /|\ 6 3 / | \ | 5 4 7 5 | /\ 6 2 1 |
se representan por
|
1 2 3 |
ej1, ej2 :: Arbol Int ej1 = N 1 [N 6 [],N 3 [N 5 []]] ej2 = N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]] |
Definir la función
|
1 |
emparejaArboles :: (a -> b -> c) -> Arbol a -> Arbol b -> Arbol c |
tal que (emparejaArboles f a1 a2) es el árbol obtenido aplicando la función f a los elementos de los árboles a1 y a2 que se encuentran en la misma posición. Por ejemplo,
|
1 2 3 4 5 6 |
λ> emparejaArboles (+) (N 1 [N 2 [], N 3[]]) (N 1 [N 6 []]) N 2 [N 8 []] λ> emparejaArboles (+) ej1 ej2 N 4 [N 11 [],N 7 []] λ> emparejaArboles (+) ej1 ej1 N 2 [N 12 [],N 6 [N 10 []]] |
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 |
module Emparejamiento_de_arboles where import Data.Tree (Tree (..)) import Control.Monad.Zip (mzipWith) import Test.QuickCheck (Arbitrary, Gen, arbitrary, sublistOf, sized, quickCheck) data Arbol a = N a [Arbol a] deriving (Show, Eq) ej1, ej2 :: Arbol Int ej1 = N 1 [N 6 [],N 3 [N 5 []]] ej2 = N 3 [N 5 [N 6 []], N 4 [], N 7 [N 2 [], N 1 []]] -- 1ª solución -- =========== emparejaArboles1 :: (a -> b -> c) -> Arbol a -> Arbol b -> Arbol c emparejaArboles1 f (N x xs) (N y ys) = N (f x y) (zipWith (emparejaArboles1 f) xs ys) -- 2ª solución -- =========== emparejaArboles2 :: (a -> b -> c) -> Arbol a -> Arbol b -> Arbol c emparejaArboles2 f x y = treeAarbol (mzipWith f (arbolAtree x) (arbolAtree y)) arbolAtree :: Arbol a -> Tree a arbolAtree (N x xs) = Node x (map arbolAtree xs) treeAarbol :: Tree a -> Arbol a treeAarbol (Node x xs) = N x (map treeAarbol xs) -- Comprobación de equivalencia -- ============================ -- (arbolArbitrario n) es un árbol aleatorio de orden n. Por ejemplo, -- λ> generate (arbolArbitrario 5 :: Gen (Arbol Int)) -- N (-26) [N 8 [N 6 [N 11 []]],N 7 []] -- λ> generate (arbolArbitrario 5 :: Gen (Arbol Int)) -- N 1 [] -- λ> generate (arbolArbitrario 5 :: Gen (Arbol Int)) -- N (-19) [N (-11) [],N 25 [],N 19 [N (-27) [],N (-19) [N 17 []]]] arbolArbitrario :: Arbitrary a => Int -> Gen (Arbol a) arbolArbitrario n = do x <- arbitrary ms <- sublistOf [0 .. n `div` 2] as <- mapM arbolArbitrario ms return (N x as) -- Arbol es una subclase de Arbitraria instance Arbitrary a => Arbitrary (Arbol a) where arbitrary = sized arbolArbitrario -- La propiedad es prop_emparejaArboles :: Arbol Int -> Arbol Int -> Bool prop_emparejaArboles x y = emparejaArboles1 (+) x y == emparejaArboles2 (+) x y && emparejaArboles1 (*) x y == emparejaArboles2 (*) x y -- La comprobación es -- λ> quickCheck prop_emparejaArboles -- +++ OK, passed 100 tests. -- Comparación de eficiencia -- ========================= -- La comparación es -- λ> a500 <- generate (arbolArbitrario 500 :: Gen (Arbol Int)) -- λ> emparejaArboles1 (+) a500 a500 == emparejaArboles1 (+) a500 a500 -- True -- (1.92 secs, 1,115,813,352 bytes) -- λ> emparejaArboles2 (+) a500 a500 == emparejaArboles2 (+) a500 a500 -- True -- (3.28 secs, 2,212,257,928 bytes) -- -- λ> b500 = arbolAtree a500 -- λ> mzipWith (+) b500 b500 == mzipWith (+) b500 b500 -- True -- (0.21 secs, 563,503,112 bytes) |
El código se encuentra en GitHub.
La elaboración de las soluciones se describe en el siguiente vídeo
2. Eliminación de las ocurrencias aisladas
Definir la función
|
1 |
eliminaAisladas :: Eq a => a -> [a] -> [a] |
tal que (eliminaAisladas x ys) es la lista obtenida eliminando en ys las ocurrencias aisladas de x (es decir, aquellas ocurrencias de x tales que su elemento anterior y posterior son distintos de x). Por ejemplo,
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 |
eliminaAisladas 'X' "" == "" eliminaAisladas 'X' "X" == "" eliminaAisladas 'X' "XX" == "XX" eliminaAisladas 'X' "XXX" == "XXX" eliminaAisladas 'X' "abcd" == "abcd" eliminaAisladas 'X' "Xabcd" == "abcd" eliminaAisladas 'X' "XXabcd" == "XXabcd" eliminaAisladas 'X' "XXXabcd" == "XXXabcd" eliminaAisladas 'X' "abcdX" == "abcd" eliminaAisladas 'X' "abcdXX" == "abcdXX" eliminaAisladas 'X' "abcdXXX" == "abcdXXX" eliminaAisladas 'X' "abXcd" == "abcd" eliminaAisladas 'X' "abXXcd" == "abXXcd" eliminaAisladas 'X' "abXXXcd" == "abXXXcd" eliminaAisladas 'X' "XabXcdX" == "abcd" eliminaAisladas 'X' "XXabXXcdXX" == "XXabXXcdXX" eliminaAisladas 'X' "XXXabXXXcdXXX" == "XXXabXXXcdXXX" eliminaAisladas 'X' "XabXXcdXeXXXfXx" == "abXXcdeXXXfx" |
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 |
module Elimina_aisladas where import Data.List (group) import Test.QuickCheck -- 1ª solución -- =========== eliminaAisladas1 :: Eq a => a -> [a] -> [a] eliminaAisladas1 _ [] = [] eliminaAisladas1 x [y] | x == y = [] | otherwise = [y] eliminaAisladas1 x (y1:y2:ys) | y1 /= x = y1 : eliminaAisladas1 x (y2:ys) | y2 /= x = y2 : eliminaAisladas1 x ys | otherwise = takeWhile (==x) (y1:y2:ys) ++ eliminaAisladas1 x (dropWhile (==x) ys) -- 2ª solución -- =========== eliminaAisladas2 :: Eq a => a -> [a] -> [a] eliminaAisladas2 _ [] = [] eliminaAisladas2 x ys | cs == [x] = as ++ eliminaAisladas2 x ds | otherwise = as ++ cs ++ eliminaAisladas2 x ds where (as,bs) = span (/=x) ys (cs,ds) = span (==x) bs -- 3ª solución -- =========== eliminaAisladas3 :: Eq a => a -> [a] -> [a] eliminaAisladas3 x ys = concat [zs | zs <- group ys, zs /= [x]] -- 4ª solución -- =========== eliminaAisladas4 :: Eq a => a -> [a] -> [a] eliminaAisladas4 x = concat . filter (/= [x]) . group -- Comprobación de equivalencia -- ============================ -- La propiedad es prop_eliminaAisladas :: Int -> [Int] -> Bool prop_eliminaAisladas x ys = all (== eliminaAisladas1 x ys) [eliminaAisladas2 x ys, eliminaAisladas3 x ys, eliminaAisladas4 x ys] -- La comprobación es -- λ> quickCheck prop_eliminaAisladas -- +++ OK, passed 100 tests. -- Comparación de eficiencia -- ========================= -- La comparación es -- λ> length (eliminaAisladas1 'a' (take (5*10^6) (cycle "abca"))) -- 4999998 -- (3.86 secs, 2,030,515,400 bytes) -- λ> length (eliminaAisladas2 'a' (take (5*10^6) (cycle "abca"))) -- 4999998 -- (3.41 secs, 2,210,516,832 bytes) -- λ> length (eliminaAisladas3 'a' (take (5*10^6) (cycle "abca"))) -- 4999998 -- (2.11 secs, 2,280,516,448 bytes) -- λ> length (eliminaAisladas4 'a' (take (5*10^6) (cycle "abca"))) -- 4999998 -- (0.92 secs, 1,920,516,704 bytes) |
El código se encuentra en GitHub.
La elaboración de las soluciones se describe en el siguiente vídeo
3. Ordenada cíclicamente
Se dice que una sucesión x(1), …, x(n) está ordenada cíclicamente si existe un índice i tal que la sucesión
|
1 |
x(i), x(i+1), ..., x(n), x(1), ..., x(i-1) |
está ordenada crecientemente de forma estricta.
Definir la función
|
1 |
ordenadaCiclicamente :: Ord a => [a] -> Maybe Int |
tal que (ordenadaCiclicamente xs) es el índice a partir del cual está ordenada, si la lista está ordenado cíclicamente y Nothing en caso contrario. Por ejemplo,
|
1 2 3 4 5 6 |
ordenadaCiclicamente [1,2,3,4] == Just 0 ordenadaCiclicamente [5,8,1,3] == Just 2 ordenadaCiclicamente [4,6,7,5,1,3] == Nothing ordenadaCiclicamente [1,0,3,2] == Nothing ordenadaCiclicamente [1,2,0] == Just 2 ordenadaCiclicamente "cdeab" == Just 3 |
Nota: Se supone que el argumento es una lista no vacía sin elementos repetidos.
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 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 |
module Ordenada_ciclicamente where import Test.QuickCheck (Arbitrary, Gen, NonEmptyList (NonEmpty), Property, arbitrary, chooseInt, collect, quickCheck) import Data.List (nub, sort) import Data.Maybe (isJust, listToMaybe) -- 1ª solución -- =========== ordenadaCiclicamente1 :: Ord a => [a] -> Maybe Int ordenadaCiclicamente1 xs = aux 0 xs where n = length xs aux i zs | i == n = Nothing | ordenada zs = Just i | otherwise = aux (i+1) (siguienteCiclo zs) -- (ordenada xs) se verifica si la lista xs está ordenada -- crecientemente. Por ejemplo, -- ordenada "acd" == True -- ordenada "acdb" == False ordenada :: Ord a => [a] -> Bool ordenada [] = True ordenada (x:xs) = all (x <) xs && ordenada xs -- (siguienteCiclo xs) es la lista obtenida añadiendo el primer elemento -- de xs al final del resto de xs. Por ejemplo, -- siguienteCiclo [3,2,5] => [2,5,3] siguienteCiclo :: [a] -> [a] siguienteCiclo [] = [] siguienteCiclo (x:xs) = xs ++ [x] -- 2ª solución -- =========== ordenadaCiclicamente2 :: Ord a => [a] -> Maybe Int ordenadaCiclicamente2 xs = listToMaybe [n | n <- [0..length xs-1], ordenada (drop n xs ++ take n xs)] -- 3ª solución -- =========== ordenadaCiclicamente3 :: Ord a => [a] -> Maybe Int ordenadaCiclicamente3 xs | ordenada (bs ++ as) = Just k | otherwise = Nothing where (_,k) = minimum (zip xs [0..]) (as,bs) = splitAt k xs -- Comprobación de equivalencia -- ============================ -- La propiedad es prop_ordenadaCiclicamente1 :: NonEmptyList Int -> Bool prop_ordenadaCiclicamente1 (NonEmpty xs) = ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs -- La comprobación es -- λ> quickCheck prop_ordenadaCiclicamente1 -- +++ OK, passed 100 tests. -- La propiedad para analizar los casos de prueba prop_ordenadaCiclicamente2 :: NonEmptyList Int -> Property prop_ordenadaCiclicamente2 (NonEmpty xs) = collect (isJust (ordenadaCiclicamente1 xs)) $ ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs -- El análisis es -- λ> quickCheck prop_ordenadaCiclicamente2 -- +++ OK, passed 100 tests: -- 89% False -- 11% True -- Tipo para generar listas newtype Lista = L [Int] deriving Show -- Generador de listas. listaArbitraria :: Gen Lista listaArbitraria = do x <- arbitrary xs <- arbitrary let ys = x : xs k <- chooseInt (0, length ys) let (as,bs) = splitAt k (sort (nub ys)) return (L (bs ++ as)) -- Lista es una subclase de Arbitrary. instance Arbitrary Lista where arbitrary = listaArbitraria -- La propiedad para analizar los casos de prueba prop_ordenadaCiclicamente3 :: Lista -> Property prop_ordenadaCiclicamente3 (L xs) = collect (isJust (ordenadaCiclicamente1 xs)) $ ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs -- El análisis es -- λ> quickCheck prop_ordenadaCiclicamente3 -- +++ OK, passed 100 tests (100% True). -- Tipo para generar newtype Lista2 = L2 [Int] deriving Show -- Generador de listas listaArbitraria2 :: Gen Lista2 listaArbitraria2 = do x' <- arbitrary xs <- arbitrary let ys = x' : xs k <- chooseInt (0, length ys) let (as,bs) = splitAt k (sort (nub ys)) n <- chooseInt (0,1) return (if even n then L2 (bs ++ as) else L2 ys) -- Lista es una subclase de Arbitrary. instance Arbitrary Lista2 where arbitrary = listaArbitraria2 -- La propiedad para analizar los casos de prueba prop_ordenadaCiclicamente4 :: Lista2 -> Property prop_ordenadaCiclicamente4 (L2 xs) = collect (isJust (ordenadaCiclicamente1 xs)) $ ordenadaCiclicamente1 xs == ordenadaCiclicamente2 xs -- El análisis es -- λ> quickCheck prop_ordenadaCiclicamente4 -- +++ OK, passed 100 tests: -- 51% True -- 49% False -- La propiedad es prop_ordenadaCiclicamente :: Lista2 -> Bool prop_ordenadaCiclicamente (L2 xs) = all (== ordenadaCiclicamente1 xs) [ordenadaCiclicamente2 xs, ordenadaCiclicamente3 xs] -- La comprobación es -- λ> quickCheck prop_ordenadaCiclicamente -- +++ OK, passed 100 tests. -- Comparación de eficiencia -- ========================= -- La comparación es -- λ> ordenadaCiclicamente1 ([100..4000] ++ [1..99]) -- Just 3901 -- (3.27 secs, 2,138,864,568 bytes) -- λ> ordenadaCiclicamente2 ([100..4000] ++ [1..99]) -- Just 3901 -- (2.44 secs, 1,430,040,008 bytes) -- λ> ordenadaCiclicamente3 ([100..4000] ++ [1..99]) -- Just 3901 -- (1.18 secs, 515,549,200 bytes) |
El código se encuentra en GitHub.
La elaboración de las soluciones se describe en el siguiente vídeo