{"id":7676,"date":"2022-03-12T06:00:52","date_gmt":"2022-03-12T05:00:52","guid":{"rendered":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/?p=7676"},"modified":"2022-03-12T07:44:42","modified_gmt":"2022-03-12T06:44:42","slug":"pfh-ejercicios-sobre-arboles-binarios-de-busqueda","status":"publish","type":"post","link":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/pfh-ejercicios-sobre-arboles-binarios-de-busqueda\/","title":{"rendered":"PFH: Ejercicios sobre \u00e1rboles binarios de b\u00fasqueda"},"content":{"rendered":"<p>He a\u00f1adido a la colecci\u00f3n de <a href=\"https:\/\/bit.ly\/3CeabJd\">Ejercicios de programaci\u00f3n funcional con Haskell<\/a> la relaci\u00f3n de <a href=\"https:\/\/bit.ly\/3pX3DcO\">\u00e1rboles binarios de b\u00fasqueda<\/a> en la que se definen los tipos de datos de los \u00e1rboles binarios y los \u00e1rboles binarios de b\u00fasqueda, se definen funciones sobre dichos tipos y se comprueban con QuickCheck propiedades de las funciones definidas.<\/p>\n<p>El contenido de la relaci\u00f3n es el siguiente<br \/>\n<!--more--><\/p>\n<pre lang=\"haskell\">\n{-# LANGUAGE DerivingStrategies         #-}\n{-# LANGUAGE GeneralisedNewtypeDeriving #-}\n\nmodule Arboles_binarios_de_busqueda where\n\nimport Data.List (nub, sort, sortBy)\nimport Data.Maybe (fromMaybe)\nimport Test.QuickCheck\nimport qualified Control.Monad.State as S\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 1. Los siguientes \u00e1rboles  binarios\n--         9                9\n--        \/ \\              \/\n--       \/   \\            \/\n--      8     6          8\n--     \/ \\   \/ \\        \/ \\\n--    3   2 4   5      3   2\n-- se pueden representar por los t\u00e9rminos\n--    N 9 (N 8 (N 3 V V) (N 2 V V)) (N 6 (N 4 V V) (N 5 V V))\n--    N 9 (N 8 (N 3 V V) (N 2 V V)) V\n-- usando los contructores N (para los nodos) y V (para los \u00e1rboles\n-- vac\u00edo).\n--\n-- Definir el tipo de datos Arbol correspondiente a los t\u00e9rminos\n-- anteriores.\n-- ---------------------------------------------------------------------\n\ndata Arbol a = N (Arbol a) a (Arbol a)\n             | V\n  deriving (Eq, Show)\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 2. Definir el procedimiento\n--    arbolArbitrario :: Arbitrary a => Int -> Gen (Arbol a)\n-- tal que (arbolArbitrario n) es un \u00e1rbol aleatorio de altura n. Por\n-- ejemplo,\n--    \u03bb> sample (arbolArbitrario 3 :: Gen (Arbol Int))\n--    N (N V 0 V) 0 V\n--    N (N (N (N (N (N V 1 V) (-1) V) (-2) V) (-1) V) 0 V) (-2) V\n--    N (N (N V (-4) V) (-4) V) 3 V\n--    N (N (N (N (N V (-5) V) 5 V) (-2) V) 4 V) (-1) V\n--    N (N (N V 5 V) 1 V) (-2) V\n--    N (N (N (N (N (N (N (N V 3 V) 10 V) 6 V) (-2) V) (-1) V) 6 V) 3 V) 6 V\n--    N (N V 10 V) 3 V\n--    N (N V 1 V) (-14) V\n--    N (N (N (N (N (N V 9 V) 15 V) 14 V) (-8) V) (-1) V) (-11) V\n--    N (N (N (N V (-8) V) 4 V) (-14) V) (-10) V\n--    N (N V (-13) V) 0 V\n-- ---------------------------------------------------------------------\n\narbolArbitrario :: Arbitrary a => Int -> Gen (Arbol a)\narbolArbitrario n\n  | n <= 1    = return V\n  | otherwise = do\n      k <- choose (2, n - 1)\n      N <$> arbolArbitrario k <*> arbitrary <*> arbolArbitrario (n - k)\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 3. Declarar Arbol como subclase de Arbitraria usando el\n-- generador arbolArbitrario.\n-- ---------------------------------------------------------------------\n\ninstance Arbitrary a => Arbitrary (Arbol a) where\n  arbitrary = sized arbolArbitrario\n  shrink V   = []\n  shrink (N i x d) = i :\n                     d :\n                     [N i' x  d  | i' <- shrink i] ++\n                     [N i  x' d  | x' <- shrink x] ++\n                     [N i  x  d' | d' <- shrink d]\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 4. Definir la funci\u00f3n\n--    mapArbol :: (a -> b) -> Arbol a -> Arbol b\n-- tal que (mapArbol f a) es el \u00e1rbol obtenido aplicando la funci\u00f3n f a\n-- los elementos del \u00e1rbol a. Por ejemplo,\n--    mapArbol (+1) (N V 7 (N V 8 V))  ==  N V 8 (N V 9 V)\n-- ---------------------------------------------------------------------\n\nmapArbol :: (a -> b) -> Arbol a -> Arbol b\nmapArbol _ V         = V\nmapArbol f (N i x d) = N (mapArbol f i) (f x) (mapArbol f d)\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 5. Comprobar con QuickCheck que, para todo \u00e1rbol a,\n--   map id a == a\n-- ---------------------------------------------------------------------\n\n-- La propiedad es\nprop_mapArbol :: Arbol Int -> Property\nprop_mapArbol t =\n  mapArbol id t === t\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_mapArbol\n--    +++ OK, passed 100 tests.\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 6. Declarar el tipo Arbol una instancia de la clase\n-- Functor.\n-- ---------------------------------------------------------------------\n\ninstance Functor Arbol where\n  fmap = mapArbol\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 7. Definir la funci\u00f3n\n--    aplana :: Arbol a -> [a]\n-- tal que (aplana a) es la lista obtenida aplanando el \u00e1rbol a. Por\n-- ejemplo,\n--    aplana (N (N V 2 V) 5 V)  ==  [2,5]\n-- ---------------------------------------------------------------------\n\naplana :: Arbol a -> [a]\naplana V         = []\naplana (N i x d) = aplana i ++ [x] ++ aplana d\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 8. Definir la funci\u00f3n\n--    estrictamenteCreciente :: Ord a => [a] -> Bool\n-- tal que (estrictamenteCreciente xs) se verifica si xs es\n-- estrictamente creciente. Por ejemplo,\n--    estrictamenteCreciente [2,3,5]  ==  True\n--    estrictamenteCreciente [2,3,3]  ==  False\n--    estrictamenteCreciente [2,5,3]  ==  False\n-- ---------------------------------------------------------------------\n\nestrictamenteCreciente :: Ord a => [a] -> Bool\nestrictamenteCreciente [] = True\nestrictamenteCreciente [_] = True\nestrictamenteCreciente (x : y : ys) = x < y &#038;&#038; estrictamenteCreciente (y : ys)\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 9. Un \u00e1rbol binario de b\u00fasqueda (ABB) es un \u00e1rbol binario\n-- tal que el valor de cada nodo es mayor que los valores de su sub\u00e1rbol\n-- izquierdo y es menor que los valores de su sub\u00e1rbol derecho y,\n-- adem\u00e1s, ambos sub\u00e1rboles son \u00e1rboles binarios de b\u00fasqueda. Por\n-- ejemplo, al almacenar los valores de [2,3,4,5,6,8,9] en un ABB se\n-- puede obtener los siguientes ABB:\n--\n--       5                     5\n--      \/ \\                   \/ \\\n--     \/   \\                 \/   \\\n--    2     6               3     8\n--     \\     \\             \/ \\   \/ \\\n--      4     8           2   4 6   9\n--     \/       \\\n--    3         9\n--\n-- El objetivo principal de los ABB es reducir el tiempo de acceso a los\n-- valores.\n--\n-- Definir la funci\u00f3n\n--    esABB :: Ord a => Arbol a -> Bool\n-- tal que (esABB a) se verifica si a es un \u00e1rbol binario de\n-- b\u00fasqueda. Por ejemplo,\n--    esABB (N (N V 2 V) 5 V)  ==  True\n--    esABB (N V 3 (N V 3 V))  ==  False\n-- ---------------------------------------------------------------------\n\nesABB :: Ord a => Arbol a -> Bool\nesABB = estrictamenteCreciente . aplana\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 10. Comprobar con QuickCheck que un \u00e1rbol binario a es un\n-- ABB si, y solo si, (aplana a) es una lista ordenada sin elementos\n-- repetidos.\n-- ---------------------------------------------------------------------\n\n-- La propiedad es\nprop_esABB :: Arbol Int -> Property\nprop_esABB a =\n  esABB a === (xs == sort (nub xs))\n  where xs = aplana a\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_esABB\n--    +++ OK, passed 100 tests.\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 11. Definir la funci\u00f3n\n--    minABB :: ABB a -> Maybe a\n-- tal que (minABB a) es el m\u00ednimo del ABB a. Por ejemplo,\n--    minABB (N (N V (-1) (N V 0 (N V 9 V))) 10 V)  ==  Just (-1)\n--    minABB V                                      ==  Nothing\n-- ---------------------------------------------------------------------\n\nminABB :: ABB a -> Maybe a\nminABB V = Nothing\nminABB (N i x _) =\n  case minABB i of\n    Nothing -> Just x\n    Just y  -> Just y\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 12. Definir la funci\u00f3n\n--    maxABB :: ABB a -> Maybe a\n-- tal que (maxABB a) es el m\u00e1ximo del ABB a. Por ejemplo,\n--    maxABB (N (N V (-1) (N V 0 (N V 9 V))) 10 V)  ==  Just 10\n--    maxABB V                                      ==  Nothing\n-- ---------------------------------------------------------------------\n\nmaxABB :: ABB a -> Maybe a\nmaxABB V = Nothing\nmaxABB (N _ x d) =\n  case maxABB d of\n    Nothing -> Just x\n    Just y  -> Just y\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 13. Definir el tipo ABB para los \u00e1rboles binarios de\n-- b\u00fasqueda (aunque el sistema de tipo no lo compruebe).\n-- ---------------------------------------------------------------------\n\ntype ABB a = Arbol a\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 14. Definir el tipo ABB' con el constructor ABB' para los\n-- \u00e1rboles binarios de b\u00fasqueda.\n-- ---------------------------------------------------------------------\n\nnewtype ABB' = ABB' (ABB Integer)\n  deriving newtype Show\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 15. Definir el procedimiento\n--    abbArbitrario :: Int -> Gen (Arbol a)\n-- tal que (abbArbitrario n) es un \u00e1rbol binario de b\u00fasqueda aleatorio\n-- de altura n. Por ejemplo,\n--    \u03bb> sample (abbArbitrario 4)\n--    N (N V (-2) (N V (-1) V)) 0 V\n--    N (N (N V (-2) V) 0 V) 1 V\n--    N (N V (-4) V) (-3) (N V (-2) V)\n--    N (N V (-1) V) 3 (N V 4 V)\n--    N V 2 (N (N V 3 V) 4 V)\n--    N (N V (-8) V) (-7) (N V (-2) V)\n--    N (N V 1 (N V 6 V)) 11 V\n--    N (N (N V (-21) V) (-12) V) (-11) V\n--    N V (-1) (N V 0 (N V 1 V))\n--    N (N V (-16) (N V (-15) V)) (-11) V\n--    N (N (N V (-6) V) (-5) V) (-4) V\n-- ---------------------------------------------------------------------\n\nabbArbitrario :: Int -> Gen ABB'\nabbArbitrario n\n  | n <= 1    = return (ABB' V)\n  | otherwise = do\n      ni <- choose (1, n - 1)\n      let nd = n - ni\n      x <- arbitrary\n      ABB' i' <- abbArbitrario ni\n      ABB' d' <- abbArbitrario nd\n      let iMax   = fromMaybe (x - 1) (maxABB i')\n          dMin   = fromMaybe (x + 1) (minABB d')\n          iDelta = max 0 (iMax - x + 1)\n          dDelta = max 0 (x - dMin + 1)\n          i      = (+ (- iDelta)) <$> i'\n          d      = (+ dDelta) <$> d'\n      return (ABB' (N i x d))\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 16. Declarar ABB' como subclase de Arbitraria usando el\n-- generador abbArbitrario.\n-- ---------------------------------------------------------------------\n\ninstance Arbitrary ABB' where\n  arbitrary = sized abbArbitrario\n  shrink (ABB' V) = []\n  shrink (ABB' (N i x d)) =\n    ABB' i :\n    ABB' d :\n    [ABB' (N i' x d) | ABB' i' <- shrink (ABB' i)] ++\n    [ABB' (N i x d') | ABB' d' <- shrink (ABB' d)]\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 17. Comprobar con QuickCheck que abbArbitrario genera\n-- \u00e1rboles binarios de b\u00fasqueda.\n-- ---------------------------------------------------------------------\n\n-- La propiedad es\nprop_abbArbitrario_esABB :: ABB' -> Bool\nprop_abbArbitrario_esABB (ABB' a) = esABB a\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_abbArbitrario_esABB\n--    +++ OK, passed 100 tests.\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 18. Definir la funci\u00f3n\n--    pertenece :: Ord a => a -> ABB a -> Bool\n-- tal que (pertenece x a) se verifica si x pertenece al ABB a. Por\n-- ejemplo,\n--    pertenece 5 (N (N V 2 V) 5 V)  ==  True\n--    pertenece 3 (N (N V 2 V) 5 V)  ==  False\n-- ---------------------------------------------------------------------\n\npertenece :: Ord a => a -> ABB a -> Bool\npertenece _ V = False\npertenece x (N i y d)\n  | x < y     = pertenece x i\n  | x > y     = pertenece x d\n  | otherwise = True\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 19. Definir la funci\u00f3n\n--    inserta :: Ord a => a -> ABB a -> ABB a\n-- tal que (inserta x a) es el ABB obtenido insertando x en a. Por\n-- ejemplo,\n--    \u03bb> inserta 7 (N (N V (-1) (N V 0 (N V 9 V))) 10 V)\n--    N (N V (-1) (N V 0 (N (N V 7 V) 9 V))) 10 V\n-- ---------------------------------------------------------------------\n\ninserta :: Ord a => a -> ABB a -> ABB a\ninserta x V = N V x V\ninserta x (N l y r)\n  | x < y     = N (inserta x l) y r\n  | x > y     = N l y (inserta x r)\n  | otherwise = N l x r\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 20. Comprobar con QuickCheck que si a es un ABB, entonces\n-- (inserta x a) es un ABB.\n-- ---------------------------------------------------------------------\n\n-- La propiedad es\nprop_inserta_ABB :: Integer -> ABB' -> Bool\nprop_inserta_ABB x (ABB' a) =\n  esABB (inserta x a)\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_inserta_ABB\n--    +++ OK, passed 100 tests.\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 21. Comprobar con QuickCheck que inserta es idempotente.\n-- ---------------------------------------------------------------------\n\n-- La propiedad es\nprop_inserta_idempotente :: Integer -> ABB' -> Property\nprop_inserta_idempotente x (ABB' a) =\n  inserta x (inserta x a) === inserta x a\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_inserta_idempotente\n--    +++ OK, passed 100 tests.\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 22. Comprobar con QuickCheck que x pertenece a (inserta x a).\n-- ---------------------------------------------------------------------\n\n-- La propiedad es\nprop_pertenece_inserta :: Integer -> ABB' -> Bool\nprop_pertenece_inserta x (ABB' a) =\n  x `pertenece` inserta x a\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_pertenece_inserta\n--    +++ OK, passed 100 tests.\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 23. Definir la funci\u00f3n\n--    borra :: Ord a => a -> ABB a -> ABB a\n-- tal que (borra x a) es el \u00e1rbol binario de b\u00fasqueda obtenido borando\n-- en a el elemento x. Por ejemplo,\n--    borra 1 (N (N V 1 V) 2 (N V 7 V))  ==  N V 2 (N V 7 V)\n--    borra 2 (N (N V 1 V) 2 (N V 7 V))  ==  N V 1 (N V 7 V)\n--    borra 7 (N (N V 1 V) 2 (N V 7 V))  ==  N (N V 1 V) 2 V\n--    borra 8 (N (N V 1 V) 2 (N V 7 V))  ==  N (N V 1 V) 2 (N V 7 V)\n-- ---------------------------------------------------------------------\n\nborra :: Ord a => a -> ABB a -> ABB a\nborra _ V = V\nborra x (N i y d)\n  | x < y     = N (borra x i) y d\n  | x > y     = N i y (borra x d)\n  | otherwise = case maxABB i of\n                  Nothing -> d\n                  Just z  -> N (borra z i) z d\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 24. Comprobar con QuickCheck que si a es un ABB, entonces\n-- (borra x a) es un ABB.\n-- ---------------------------------------------------------------------\n\n-- La propiedad es\nprop_borra_ABB :: Integer -> ABB' -> Bool\nprop_borra_ABB x (ABB' a) =\n  esABB (borra x a)\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_borra_ABB\n--    +++ OK, passed 100 tests.\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 25. Comprobar con QuickCheck que si a es un ABB, entonces\n-- x no pertenece a (borra x a).\n-- ---------------------------------------------------------------------\n\n-- La propiedad es\nprop_pertenece_borra :: Integer -> ABB' -> Bool\nprop_pertenece_borra x (ABB' a) =\n  not (pertenece x (borra x a))\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_pertenece_borra\n--    +++ OK, passed 100 tests.\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 26. Definir la funci\u00f3n\n--    ordenadaDescendente :: Ord a => [a] -> [a]\n-- tal que (ordenadaDescendente xs) es la lista obtenida ordenando xs de\n-- manera descendente. Por ejemplo,\n--    ordenadaDescendente [3,2,5]  ==  [5,3,2]\n-- ---------------------------------------------------------------------\n\n-- 1\u00aa definici\u00f3n\nordenadaDescendente1 :: Ord a => [a] -> [a]\nordenadaDescendente1 = reverse . sort\n\n-- 2\u00aa definici\u00f3n\nordenadaDescendente :: Ord a => [a] -> [a]\nordenadaDescendente = sortBy (flip compare)\n\n-- Comprobaci\u00f3n de la equivalencia\n-- ===============================\n\n-- La propiedad es\nprop_ordenadaDescendente :: [Int] -> Property\nprop_ordenadaDescendente xs =\n  ordenadaDescendente1 xs === ordenadaDescendente xs\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_ordenadaDescendente\n--    +++ OK, passed 100 tests.\n\n-- Comparaci\u00f3n de eficiencia\n-- =========================\n\n-- La comparaci\u00f3n es\n--    \u03bb> last (ordenadaDescendente1 [1..7*10^6])\n--    1\n--    (1.54 secs, 1,008,339,840 bytes)\n--    \u03bb> last (ordenadaDescendente [1..7*10^6])\n--    1\n--    (0.85 secs, 672,339,848 bytes)\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 27. Definir la funci\u00f3n\n--    listaAabb :: Ord a => [a] -> ABB a\n-- tal que (listaAabb xs) es un \u00e1rbol binario de b\u00fasqueda cuyos\n-- elementos son los de xs. Por ejemplo,\n--    \u03bb> listaAabb [5,1,2,4,3]\n--    N (N (N V 1 V) 2 V) 3 (N V 4 (N V 5 V))\n-- ---------------------------------------------------------------------\n\nlistaAabb :: Ord a => [a] -> ABB a\nlistaAabb = foldr inserta V\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 28. Comprobar con QuickCheck que, para toda lista xs,\n-- (listaAabb xs) esun \u00e1rbol binario de b\u00fasqueda.\n-- ---------------------------------------------------------------------\n\n-- La propiedad es\nprop_listaAabb_esABB :: [Int] -> Bool\nprop_listaAabb_esABB xs = esABB (listaAabb xs)\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_listaAabb_esABB\n--    +++ OK, passed 100 tests.\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 29. Comprobar con QuickCheck que, para toda lista xs,\n-- aplana (listaAabb xs) es la lista ordenada de los elementos de xs sin\n-- repeticiones.\n-- ---------------------------------------------------------------------\n\n-- La propiedad es\nprop_listaAabb_ordena :: [Int] -> Property\nprop_listaAabb_ordena xs =\n  aplana (listaAabb xs) === nub (sort xs)\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_listaAabb_ordena\n--    +++ OK, passed 100 tests.\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 30. Definir la funci\u00f3n\n--    etiquetaArbol :: Arbol a -> [b] -> Arbol (a, b)\n-- tal que (etiquetaArbolt xs) es el \u00e1rbol t con las hojas etiquetadas\n-- con elementos de xs. Por ejemplo,\n--    \u03bb> etiquetaArbol (N (N (N (N V 8 V) 4 V) 5 V) 7 V) \"Betis\"\n--    N (N (N (N V (8,'B') V) (4,'e') V) (5,'t') V) (7,'i') V\n-- ---------------------------------------------------------------------\n\netiquetaArbol :: Arbol a -> [b] -> Arbol (a, b)\netiquetaArbol t xs = fst (aux xs t)\n  where\n    aux :: [b] -> Arbol a -> (Arbol (a, b), [b])\n    aux ys V         = (V, ys)\n    aux ys (N i x d) = (N i' (x, b) d', ys'')\n      where (i', b : ys') = aux ys i\n            (d', ys'')    = aux ys' d\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 31. Definir la funci\u00f3n\n--    enumeraArbol :: Arbol a -> Arbol (a, Int)\n-- tal que (enumeraArbolt xs) es el \u00e1rbol t con las hojas enumeradas\n-- por n\u00fameros crecientes de izquierda a derecha. Por ejemplo,\n--    \u03bb> enumeraArbol (N (N (N (N V 8 V) 4 V) 5 V) 7 V)\n--    N (N (N (N V (8,1) V) (4,2) V) (5,3) V) (7,4) V\n-- ---------------------------------------------------------------------\n\nenumeraArbol :: Arbol a -> Arbol (a, Int)\nenumeraArbol = flip etiquetaArbol [1..]\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 32. Definir la funci\u00f3n\n--    traverseArbol :: Applicative f => (a -> f b) -> Arbol a -> f (Arbol b)\n-- tal que (traverseArbol f a) aplica a cada elemento de a la acci\u00f3n f,\n-- las acciones las eval\u00faa de izquierda a derecha y recolexta los\n-- resultados. Por ejemplo,\n--    \u03bb> dec n x = if x > n then Just (x - 1) else Nothing\n--    \u03bb> traverseArbol (dec 3) (N (N (N (N V 8 V) 4 V) 5 V) 7 V)\n--    Just (N (N (N (N V 7 V) 3 V) 4 V) 6 V)\n--    \u03bb> traverseArbol (dec 4) (N (N (N (N V 8 V) 4 V) 5 V) 7 V)\n--    Nothing\n-- ---------------------------------------------------------------------\n\ntraverseArbol :: Applicative f => (a -> f b) -> Arbol a -> f (Arbol b)\ntraverseArbol _ V         = pure V\ntraverseArbol f (N l x r) = N <$> traverseArbol f l <*> f x <*> traverseArbol f r\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 33. Definir, usando traverseArbol, la funci\u00f3n\n--    enumeraArbol' :: Arbol a -> Arbol (a, Int)\n-- que sea equivalente a enumeraArbol. Por ejemplo,\n--    \u03bb> dec n x = if x > n then Just (x - 1) else Nothing\n--    \u03bb> traverseArbol' (dec 3) (N (N (N (N V 8 V) 4 V) 5 V) 7 V)\n--    Just (N (N (N (N V 7 V) 3 V) 4 V) 6 V)\n--    \u03bb> traverseArbol' (dec 4) (N (N (N (N V 8 V) 4 V) 5 V) 7 V)\n--    Nothing\n-- ---------------------------------------------------------------------\n\nenumeraArbol' :: Arbol a -> Arbol (a, Int)\nenumeraArbol' t = S.evalState (traverseArbol f t) 1\n  where\n    f c = do\n      l <- S.get\n      S.put $ succ l\n      return (c, l)\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 34. Comprobar con QuickCheck que las funciones enumeraArbol\n-- y enumeraArbol' son equivalentes.\n-- ---------------------------------------------------------------------\n\n-- La propiedad es\nprop_enumeraArbol :: Arbol Char -> Property\nprop_enumeraArbol a =\n  enumeraArbol a === enumeraArbol' a\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_enumeraArbol\n--    +++ OK, passed 100 tests.\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 35. Definir la funci\u00f3n\n--    foldrArbol :: (a -> b -> b) -> b -> Arbol a -> b\n-- tal que (foldrArbol f e) pliega el \u00e1rbol a de derecha a izquierda\n-- usando el operador f y el valor inicial e. Por ejemplo,\n--    foldrArbol (+) 0 (N (N (N (N V 8 V) 2 V) 6 V) 4 V)  ==  20\n--    foldrArbol (*) 1 (N (N (N (N V 8 V) 2 V) 6 V) 4 V)  ==  384\n-- ---------------------------------------------------------------------\n\nfoldrArbol :: (a -> b -> b) -> b -> Arbol a -> b\nfoldrArbol f e = foldr f e . aplana\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 36. Declarar el tipo Arbol una instancia de la clase\n-- Foldable.\n-- ---------------------------------------------------------------------\n\ninstance Foldable Arbol where\n  foldr = foldrArbol\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 37. Dado el \u00e1rbol\n--    a = N (N (N (N V 8 V) 2 V) 6 V) 4 V\n-- Calcular su longitud, m\u00e1ximo, m\u00ednimo, suma, producto y lista de\n-- elementos.\n-- ---------------------------------------------------------------------\n\n-- El c\u00e1lculo es\n--    \u03bb> a = N (N (N (N V 8 V) 2 V) 6 V) 4 V\n--    \u03bb> length a\n--    4\n--    \u03bb> maximum a\n--    8\n--    \u03bb> minimum a\n--    2\n--    \u03bb> sum a\n--    20\n--    \u03bb> product a\n--    384\n--    \u03bb> Data.Foldable.toList a\n--    [8,2,6,4]\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 38. Definir, usando foldr, la funci\u00f3n\n--    aplana' :: Arbol a -> [a]\n-- tal que (aplana a) es la lista obtenida aplanando el \u00e1rbol a. Por\n-- ejemplo,\n--    aplana' (N (N V 2 V) 5 V)  ==  [2,5]\n-- ---------------------------------------------------------------------\n\naplana' :: Arbol a -> [a]\naplana' = foldr (:) []\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 39. Comprobar con QuickCheck que las funciones aplana y\n-- aplana' son equivalentes.\n-- ---------------------------------------------------------------------\n\n-- La propiedad es\nprop_aplana :: Arbol Int -> Property\nprop_aplana a =\n  aplana a === aplana' a\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_aplana\n--    +++ OK, passed 100 tests.\n\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 30. Definir la funci\u00f3n\n--    todos :: Foldable t => (a -> Bool) -> t a -> Bool\n-- tal que (todos p xs) se verifica si todos los elementos de xs cumplen\n-- la propiedad p. Por ejemplo,\n--    todos even [2,6,4]  ==  True\n--    todos even [2,5,4]  ==  False\n--    todos even (Just 6) ==  True\n--    todos even (Just 5) ==  False\n--    todos even Nothing  ==  True\n--    todos even (N (N (N (N V 8 V) 2 V) 6 V) 4 V)  ==  True\n--    todos even (N (N (N (N V 8 V) 5 V) 6 V) 4 V)  ==  False\n-- ---------------------------------------------------------------------\n\ntodos :: Foldable t => (a -> Bool) -> t a -> Bool\ntodos p = foldr (\\x b -> p x && b) True\n<\/pre>\n","protected":false},"excerpt":{"rendered":"<p>He a\u00f1adido a la colecci\u00f3n de Ejercicios de programaci\u00f3n funcional con Haskell la relaci\u00f3n de \u00e1rboles binarios de b\u00fasqueda en la que se definen los tipos de datos de los \u00e1rboles binarios y los \u00e1rboles binarios de b\u00fasqueda, se definen funciones sobre dichos tipos y se comprueban con QuickCheck propiedades de las funciones definidas. El&#8230;<\/p>\n","protected":false},"author":2,"featured_media":0,"comment_status":"closed","ping_status":"open","sticky":false,"template":"","format":"standard","meta":{"jetpack_post_was_ever_published":false,"_kad_post_transparent":"","_kad_post_title":"","_kad_post_layout":"","_kad_post_sidebar_id":"","_kad_post_content_style":"","_kad_post_vertical_padding":"","_kad_post_feature":"","_kad_post_feature_position":"","_kad_post_header":false,"_kad_post_footer":false,"_jetpack_newsletter_access":"","_jetpack_dont_email_post_to_subs":false,"_jetpack_newsletter_tier_id":0,"_jetpack_memberships_contains_paywalled_content":false,"footnotes":"","_jetpack_memberships_contains_paid_content":false},"categories":[337],"tags":[],"jetpack_featured_media_url":"","jetpack_sharing_enabled":true,"jetpack_likes_enabled":false,"_links":{"self":[{"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/posts\/7676"}],"collection":[{"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/users\/2"}],"replies":[{"embeddable":true,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/comments?post=7676"}],"version-history":[{"count":4,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/posts\/7676\/revisions"}],"predecessor-version":[{"id":7683,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/posts\/7676\/revisions\/7683"}],"wp:attachment":[{"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/media?parent=7676"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/categories?post=7676"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/tags?post=7676"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}