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
Nuevas soluciones
- En los comentarios se pueden escribir nuevas soluciones.
- El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>