{"id":7657,"date":"2022-03-04T17:01:56","date_gmt":"2022-03-04T16:01:56","guid":{"rendered":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/?p=7657"},"modified":"2022-03-05T10:43:03","modified_gmt":"2022-03-05T09:43:03","slug":"pfh-tipos-de-datos-algebraicos-en-haskell","status":"publish","type":"post","link":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/pfh-tipos-de-datos-algebraicos-en-haskell\/","title":{"rendered":"PFH: Tipos de datos algebraicos en Haskell"},"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 <a href=\"https:\/\/bit.ly\/3vEMcl6\">Tipos de datos algebraicos en Haskell<\/a> en la que se estudian los tipos abstractos de datos (TAD) tantos los predefinidos (como booleanos, opcionales, pares y listas) como definidos (\u00e1rboles binarios). Se definen funciones sobre los TAD y se verifican propiedades con QuickCheck (en el caso de los TAD se definen sus generadores de elementos arbitrarios).<\/p>\n<p>El contenido de la relaci\u00f3n es el siguiente<br \/>\n<!--more--><\/p>\n<pre lang=\"haskell\">\n-- ---------------------------------------------------------------------\n-- \u00a7 Introducci\u00f3n                                                     --\n-- ---------------------------------------------------------------------\n\n-- En esta relaci\u00f3n de ejercicio se estudian los tipos abstractos de\n-- datos (TAD) tantos  los predefinidos (como booleanos, opcionales, pares y\n-- listas) como definidos (\u00e1rboles binarios). Se definen funciones sobre\n-- los TAD y se verifican propiedades con QuickCheck (en el caso de los\n-- TAD se definen sus generadores de elementos arbitrarios).\n\nmodule Tipos_de_datos where\n\n-- Se ocultas funciones que se van a definir.\nimport Prelude hiding ((++), or, reverse, filter)\nimport Test.QuickCheck\nimport Control.Applicative ((<|>), liftA2)\n\n-- ---------------------------------------------------------------------\n-- \u00a7 Booleanos                                                        --\n-- ---------------------------------------------------------------------\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 1. Definir la funci\u00f3n\n--    implicacion :: Bool -> Bool -> Bool\n-- tal que (implicacion b c) es la implicaci\u00f3n entre b y c; su tabla es\n--          | False | True\n--    ------+-------+------\n--    False | True  | True\n--    True  | False | True\n-- Por ejemplo,\n--    implicacion False False  ==  True\n--    implicacion True False   ==  False\n-- ---------------------------------------------------------------------\n\nimplicacion :: Bool -> Bool -> Bool\nimplicacion False _ = True\nimplicacion True  b = b\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 2. Redefinir la funci\u00f3n\n--    implicacion' :: Bool -> Bool -> Bool\n-- usando la negaci\u00f3n y la disyunci\u00f3n.\n-- ---------------------------------------------------------------------\n\nimplicacion' :: Bool -> Bool -> Bool\nimplicacion' x y = y || not x\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 3. Comprobar con QuickCheck que las funciones implicacion e\n-- implicacion' son equivalentes.\n-- ---------------------------------------------------------------------\n\n-- La propiedad es\nprop_implicacion_implicacion' :: Bool -> Bool -> Property\nprop_implicacion_implicacion' x y =\n  implicacion x y === implicacion' x y\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_implicacion_implicacion'\n--    +++ OK, passed 100 tests.\n\n-- ---------------------------------------------------------------------\n-- \u00a7 Maybe                                                            --\n-- ---------------------------------------------------------------------\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 4. Definir la funci\u00f3n\n--    orelse :: Maybe a -> Maybe a -> Maybe a\n-- tal que (orelse m1 m2) es m1 si es no nulo y m2 en caso contrario.\n-- Por ejemplo,\n--    Nothing `orelse` Nothing == Nothing\n--    Nothing `orelse` Just 5  == Just 5\n--    Just 3  `orelse` Nothing == Just 3\n--    Just 3  `orelse` Just 5  == Just 3\n-- ---------------------------------------------------------------------\n\norelse :: Maybe a -> Maybe a -> Maybe a\norelse m@(Just _) _ = m\norelse _          n = n\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 5. Definir la funci\u00f3n\n--    mapMaybe :: (a -> b) -> Maybe a -> Maybe b\n-- tal que (mapMaybe f m) es el resultado de aplicar f al contenido de\n-- m. Por ejemplo,\n--    mapMaybe (+ 2) (Just 6)  ==  Just 8\n--    mapMaybe (+ 2) Nothing   ==  Nothing\n-- ---------------------------------------------------------------------\n\nmapMaybe :: (a -> b) -> Maybe a -> Maybe b\nmapMaybe f (Just x) = Just (f x)\nmapMaybe _ Nothing  = Nothing\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 6. Definir, usndo (<|>), la funci\u00f3n\n--    orelse' :: Maybe a -> Maybe a -> Maybe a\n-- tal que (orelse m1 m2) es m1 si es no nulo y m2 en caso\n-- contrario. Por ejemplo,\n--    Nothing `orelse'` Nothing == Nothing\n--    Nothing `orelse'` Just 5  == Just 5\n--    Just 3  `orelse'` Nothing == Just 3\n--    Just 3  `orelse'` Just 5  == Just 3\n-- ---------------------------------------------------------------------\n\norelse' :: Maybe a -> Maybe a -> Maybe a\norelse' = (<|>)\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 7. Comprobar con QuickCheck que las funciones implicacion e\n-- implicacion' son equivalentes.\n-- ---------------------------------------------------------------------\n\n-- La propiedad es\nprop_orelse_orelse' :: Maybe Int -> Maybe Int -> Property\nprop_orelse_orelse' x y =\n  orelse x y === orelse' x y\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_orelse_orelse'\n--    +++ OK, passed 100 tests.\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 8. Definir, usando <$>, la funci\u00f3n\n--    mapMaybe' :: (a -> b) -> Maybe a -> Maybe b\n-- tal que (mapMaybe' f m) es el resultado de aplicar f al contenido de\n-- m. Por ejemplo,\n--    mapMaybe' (+ 2) (Just 6)  ==  Just 8\n--    mapMaybe' (+ 2) Nothing   ==  Nothing\n-- ---------------------------------------------------------------------\n\nmapMaybe' :: (a -> b) -> Maybe a -> Maybe b\nmapMaybe' = (<$>)\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 9. Definir la funci\u00f3n\n--    parMaybe :: Maybe a -> Maybe b -> Maybe (a, b)\n-- tal que (parMaybe m1 m2) es jost el par de los contenidos de m1 y m2\n-- si ambos tienen contenido y Nothing en caso contrario. Por ejemplo,\n--    parMaybe (Just 'x') (Just 'y')  ==  Just ('x','y')\n--    parMaybe (Just 42) Nothing      ==  Nothing\n-- ---------------------------------------------------------------------\n\nparMaybe :: Maybe a -> Maybe b -> Maybe (a, b)\nparMaybe (Just x) (Just y) = Just (x, y)\nparMaybe _        _        = Nothing\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 10. Definir la funci\u00f3n\n--    liftMaybe :: (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c\n-- tal que (liftMaybe f m1 m2) es el resultado de aplicar f a los\n-- contenidos de m1 y m2 si tienen contenido y Nothing, en caso\n-- contrario. Por ejemplo,\n--    liftMaybe (*)  (Just 2)    (Just 3)      ==  Just 6\n--    liftMaybe (*)  (Just 2)    Nothing       ==  Nothing\n--    liftMaybe (++) (Just \"ab\") (Just \"cd\")   ==  Just \"abcd\"\n--    liftMaybe elem (Just 'b')  (Just \"abc\")  ==  Just True\n--    liftMaybe elem (Just 'p')  (Just \"abc\")  ==  Just False\n-- ---------------------------------------------------------------------\n\nliftMaybe :: (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c\nliftMaybe f (Just a) (Just b) = Just (f a b)\nliftMaybe _ _        _        = Nothing\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 11. Definir, usando liftMaybe, la funci\u00f3n\n--    parMaybe' :: Maybe a -> Maybe b -> Maybe (a, b)\n-- tal que (parMaybe' m1 m2) es jost el par de los contenidos de m1 y m2\n-- si ambos tienen contenido y Nothing en caso contrario. Por ejemplo,\n--    parMaybe' (Just 'x') (Just 'y')  ==  Just ('x','y')\n--    parMaybe' (Just 42) Nothing      ==  Nothing\n-- ---------------------------------------------------------------------\n\nparMaybe' :: Maybe a -> Maybe b -> Maybe (a, b)\nparMaybe' = liftMaybe (,)\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 12. Comprobar con QuickCheck que las funciones parMaybe e\n-- parMaybe' son equivalentes.\n-- ---------------------------------------------------------------------\n\n-- La propiedad es\nprop_parMaybe_parMaybe' :: Maybe Int -> Maybe Int -> Property\nprop_parMaybe_parMaybe' x y =\n  parMaybe x y === parMaybe' x y\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_parMaybe_parMaybe'\n--    +++ OK, passed 100 tests.\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 13. Definir la funci\u00f3n\n--    sumaMaybes :: Maybe Int -> Maybe Int -> Maybe Int\n-- tal que (sumaMaybes m1 m2) es la suma de los contenidos de m1 y m2 si\n-- tienen contenido y Nothing, en caso contrario. Por ejemplo,\n--    Just 2  `sumaMaybes` Just 3  == Just 5\n--    Just 2  `sumaMaybes` Nothing == Nothing\n--    Nothing `sumaMaybes` Just 3  == Nothing\n--    Nothing `sumaMaybes` Nothing == Nothing\n-- ---------------------------------------------------------------------\n\nsumaMaybes :: Maybe Int -> Maybe Int -> Maybe Int\nsumaMaybes = liftMaybe (+)\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 14. Definir (usando 'parMaybe', 'uncurry' y 'mapMaybe') la\n-- funci\u00f3n\n--    sumaMaybes' :: Maybe Int -> Maybe Int -> Maybe Int\n-- tal que (addMaybe's m1 m2) es la suma de los contenidos de m1 y m2 si\n-- tienen contenido y Nothing, en caso contrario. Por ejemplo,\n--    Just 2  `addMaybe's` Just 3  == Just 5\n--    Just 2  `addMaybe's` Nothing == Nothing\n--    Nothing `addMaybe's` Just 3  == Nothing\n--    Nothing `addMaybe's` Nothing == Nothing\n-- ---------------------------------------------------------------------\n\nsumaMaybes' :: Maybe Int -> Maybe Int -> Maybe Int\nsumaMaybes' x y = mapMaybe (uncurry (+)) (parMaybe x y)\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 15. Comprobar con QuickCheck que las funciones sumaMaybes y\n-- sumaMaybes' son equivalentes.\n-- ---------------------------------------------------------------------\n\n-- La propiedad es\nprop_sumaMaybes_sumaMaybes' :: Maybe Int -> Maybe Int -> Property\nprop_sumaMaybes_sumaMaybes' x y =\n  sumaMaybes x y === sumaMaybes' x y\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_sumaMaybes_sumaMaybes'\n--    +++ OK, passed 100 tests.\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 16. Definir, usando liftA2, la funci\u00f3n\n--    liftMaybe' :: (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c\n-- tal que (liftMaybe's f m1 m2) es el resultado de aplicar f a los\n-- contenidos de m1 y m2 si tienen contenido y Nothing, en caso\n-- contrario. Por ejemplo,\n--    liftMaybe' (*)  (Just 2)    (Just 3)      ==  Just 6\n--    liftMaybe' (*)  (Just 2)    Nothing       ==  Nothing\n--    liftMaybe' (++) (Just \"ab\") (Just \"cd\")   ==  Just \"abcd\"\n--    liftMaybe' elem (Just 'b')  (Just \"abc\")  ==  Just True\n--    liftMaybe' elem (Just 'p')  (Just \"abc\")  ==  Just False\n-- ---------------------------------------------------------------------\n\nliftMaybe' :: (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c\nliftMaybe' = liftA2\n\n-- ---------------------------------------------------------------------\n-- \u00a7 Pares                                                            --\n-- ---------------------------------------------------------------------\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 17. Definir la funci\u00f3n\n--    aplicaAmbas :: (a -> b) -> (a -> c) -> a -> (b, c)\n-- tal que (aplicaAmbas f g x) es el par obtenido aplic\u00e1ndole a x las\n-- funciones f y g. Por ejemplo,\n--    aplicaAmbas (+ 1) (* 2) 7  ==  (8,14)\n-- ---------------------------------------------------------------------\n\naplicaAmbas :: (a -> b) -> (a -> c) -> a -> (b, c)\naplicaAmbas f g a = (f a, g a)\n\n-- ---------------------------------------------------------------------\n-- \u00a7 Listas                                                           --\n-- ---------------------------------------------------------------------\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 18. Definir la funci\u00f3n\n--    (++) :: [a] -> [a] -> [a]\n-- tal que (xs ++ ys) es la concatenaci\u00f3n de xs e ys. Por ejemplo,\n--    [2,3] ++ [4,5,1]  ==  [2,3,4,5,1]\n-- ---------------------------------------------------------------------\n\n(++) :: [a] -> [a] -> [a]\n[]     ++ ys = ys\n(x:xs) ++ ys = x : (xs ++ ys)\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 19. Definir la funci\u00f3n\n--    or :: [Bool] -> Bool\n-- tal que (or xs) se verifca si alg\u00fan elemento de xs es verdadero. Por\n-- ejemplo,\n--    or [False,True,False]   ==  True\n--    or [False,False,False]  ==  False\n-- ---------------------------------------------------------------------\n\nor :: [Bool] -> Bool\nor []           = False\nor (True : _)   = True\nor (False : bs) = or bs\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 20. Definir la funci\u00f3n\n--    reverse :: [a] -> [a]\n-- tal que (reverse xs) es la inversa de xs. Por ejemplo,\n--    reverse [4,2,5]  ==  [5,2,4]\n-- ---------------------------------------------------------------------\n\nreverse :: [a] -> [a]\nreverse []       = []\nreverse (x : xs) = reverse xs ++ [x]\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 21. Definir (sin usar reverse ni ++) la funci\u00f3n\n--    reverseAcc :: [a] -> [a] -> [a]\n-- tal que (reverseAcc xs ys) es la concatenci\u00f3n de xs y la inversa de\n-- ys. Por ejemplo,\n--    reverseAcc [3,2] [7,5,1]  ==  [1,5,7,3,2]\n-- ---------------------------------------------------------------------\n\nreverseAcc :: [a] -> [a] -> [a]\nreverseAcc acc []       = acc\nreverseAcc acc (x : xs) = reverseAcc (x : acc) xs\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 22. Definir, usando reverseAcc, la funci\u00f3n\n--    reverse' :: [a] -> [a]\n-- tal que (reverse' xs) es la inversa de xs. Por ejemplo,\n--    reverse' [4,2,5]  ==  [5,2,4]\n-- ---------------------------------------------------------------------\n\nreverse' :: [a] -> [a]\nreverse' = reverseAcc []\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 23. Comprobar con QuickCheck que las funciones reverse y\n-- reverse' son equivalentes.\n-- ---------------------------------------------------------------------\n\n-- La propiedad es\nprop_reverse_reverse' :: [Int] -> Property\nprop_reverse_reverse' xs =\n  reverse xs === reverse' xs\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_reverse_reverse'\n--    +++ OK, passed 100 tests.\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 24. Comparar la eficiencia de reverse y reverse' calculando\n-- el tiempo de las siguientes evaluaciones\n--    last (reverse [1..10^4])\n--    last (reverse' [1..10^4])\n-- ---------------------------------------------------------------------\n\n-- La omparaci\u00f3n es\n--    \u03bb> ;set +s\n--    \u03bb> last (reverse [1..10^4])\n--    1\n--    (6.25 secs, 8,759,415,640 bytes)\n--    \u03bb> last (reverse' [1..10^4])\n--    1\n--    (0.01 secs, 2,321,888 bytes)\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 25. Definir la funci\u00f3n\n--    filter :: (a -> Bool) -> [a] -> [a]\n-- tal que (filter p xs) es la lista de los elementos de xs que cumplen\n-- la propiedad p. Por ejmplo,\n--    filter even [4,5,2]  ==  [4,2]\n--    filter odd  [4,5,2]  ==  [5]\n-- ---------------------------------------------------------------------\n\nfilter :: (a -> Bool) -> [a] -> [a]\nfilter _ []       = []\nfilter p (x : xs)\n  | p x         = x : filter p xs\n  | otherwise   = filter p xs\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 26. Definir la funci\u00f3n\n--    divisores :: Integral a => a -> [a]\n-- tal que (divisores n) es la lista de los divisores de n. Por ejemplo,\n--    divisores 24  ==  [1,2,3,4,6,8,12,24]\n-- ---------------------------------------------------------------------\n\ndivisores :: Integral a => a -> [a]\ndivisores n = filter (\\x -> mod n x == 0) [1 .. n]\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 27. Definir la funci\u00f3n\n--    esPrimo :: Integral a => a -> Bool\n-- tal que (esPrimo n) se verifica si n esprimo. Por ejemplo,\n--    esPrimo 7  ==  True\n--    esPrimo 9  ==  False\n-- ---------------------------------------------------------------------\n\nesPrimo :: Integral a => a -> Bool\nesPrimo n = divisores n == [1, n]\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 28. Definir la lista\n--    milPrimos :: [Int]\n-- formada por los 1000 primeros n\u00fameros primos.\n-- ---------------------------------------------------------------------\n\nmilPrimos :: [Int]\nmilPrimos = take 1000 (filter esPrimo [1 ..])\n\n-- ---------------------------------------------------------------------\n-- \u00a7 \u00c1rboles binarios                                                 --\n-- ---------------------------------------------------------------------\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 29. Definir el tipo de datos Arbol para los \u00e1rboles\n-- binarios, con valores s\u00f3lo en las hojas.\n-- ---------------------------------------------------------------------\n\ndata Arbol a = Hoja a\n             | Nodo (Arbol a) (Arbol a)\n  deriving (Eq, Show)\n\n-- En los ejemplos se usar\u00e1n los siguientes \u00e1rboles\narbol1, arbol2, arbol3, arbol4 :: Arbol Int\narbol1 = Hoja 1\narbol2 = Nodo (Hoja 2) (Hoja 4)\narbol3 = Nodo arbol2 arbol1\narbol4 = Nodo arbol2 arbol3\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 30. Definir la funci\u00f3n\n--    altura :: Arbol a -> Int\n-- tal que (altura t) es la altura del \u00e1rbol t. Por ejemplo,\n--    \u03bb> altura (Nodo (Hoja 3) (Nodo (Nodo (Hoja 1) (Hoja 7)) (Hoja 2)))\n--    3\n-- ---------------------------------------------------------------------\n\naltura :: Arbol a -> Int\naltura (Hoja _)   = 0\naltura (Nodo l r) = 1 + max (altura l) (altura r)\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 31. Definir la funci\u00f3n\n--    mapArbol :: (a -> b) -> Arbol a -> Arbol b\n-- tal que (mapArbol f t) es el \u00e1rbolo obtenido aplicando la funci\u00f3n f a\n-- los elementos del \u00e1rbol t. Por ejemplo,\n--    \u03bb> mapArbol (+ 1) (Nodo (Hoja 2) (Hoja 4))\n--    Nodo (Hoja 3) (Hoja 5)\n-- ---------------------------------------------------------------------\n\nmapArbol :: (a -> b) -> Arbol a -> Arbol b\nmapArbol f (Hoja a)   = Hoja (f a)\nmapArbol f (Nodo l r) = Nodo (mapArbol f l) (mapArbol f r)\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 32. Definir la funci\u00f3n\n--    mismaForma :: Arbol a -> Arbol b -> Bool\n-- tal que (mismaForma t1 t2) se verifica si t1 y t2 tienen la misma\n-- estructura. Por ejemplo,\n--    mismaForma arbol3 (mapArbol (* 10) arbol3)  ==  True\n--    mismaForma arbol1 arbol2                    ==  False\n-- ---------------------------------------------------------------------\n\nmismaForma :: Arbol a -> Arbol b -> Bool\nmismaForma (Hoja _)   (Hoja _)     = True\nmismaForma (Nodo l r) (Nodo l' r') = mismaForma l l' && mismaForma r r'\nmismaForma _          _            = False\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 33. Definir (usando ==, mapArbol, const y ()) la funci\u00f3n\n--    mismaForma' :: Arbol a -> Arbol b -> Bool\n-- tal que (mismaForma' t1 t2) se verifica si t1 y t2 tienen la misma\n-- estructura. Por ejemplo,\n--    mismaForma' arbol3 (mapArbol (* 10) arbol3)  ==  True\n--    mismaForma' arbol1 arbol2                    ==  False\n-- ---------------------------------------------------------------------\n\nmismaForma' :: Arbol a -> Arbol b -> Bool\nmismaForma' x y = f x == f y\n  where\n    f = mapArbol (const ())\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 34. 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--    Nodo (Nodo (Nodo (Hoja 0) (Hoja 0)) (Hoja 0)) (Hoja 0)\n--    Nodo (Nodo (Hoja 1) (Hoja (-1))) (Hoja (-1))\n--    --    Nodo (Nodo (Hoja 3) (Hoja 1)) (Hoja 4)\n--    Nodo (Nodo (Hoja 4) (Hoja 8)) (Hoja (-4))\n--    Nodo (Nodo (Nodo (Hoja 4) (Hoja 10)) (Hoja (-6))) (Hoja (-1))\n--    Nodo (Nodo (Hoja 3) (Hoja 6)) (Hoja (-5))\n--    Nodo (Nodo (Hoja (-11)) (Hoja (-13))) (Hoja 14)\n--    Nodo (Nodo (Hoja (-7)) (Hoja 15)) (Hoja (-2))\n--    Nodo (Nodo (Hoja (-9)) (Hoja (-2))) (Hoja (-6))\n--    Nodo (Nodo (Hoja (-15)) (Hoja (-16))) (Hoja (-20))\n-- ---------------------------------------------------------------------\n\narbolArbitrario :: Arbitrary a => Int -> Gen (Arbol a)\narbolArbitrario n\n  | n <= 1    = Hoja <$> arbitrary\n  | otherwise = do\n      k <- choose (2, n - 1)\n      Nodo <$> arbolArbitrario k <*> arbolArbitrario (n - k)\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 35. 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 (Hoja x)   = Hoja <$> shrink x\n  shrink (Nodo l r) = l :\n                      r :\n                      [Nodo l' r | l' <- shrink l] ++\n                      [Nodo l r' | r' <- shrink r]\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 36. Comprobar con QuickCheck que las funciones mismaForma y\n-- mismaForma' son equivalentes.\n-- ---------------------------------------------------------------------\n\n-- La propiedad es\nprop_mismaForma_mismaForma' :: Arbol Int -> Arbol Int -> Property\nprop_mismaForma_mismaForma' a1 a2 =\n  mismaForma a1 a2 === mismaForma' a1 a2\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_mismaForma_mismaForma'\n--    +++ OK, passed 100 tests.\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 37. Definir la funci\u00f3n\n--    creaArbol :: Int -> Arbol ()\n-- tal que (creaArbol n) es el \u00e1rbol cuyas hoyas est\u00e1n en la profundidad\n-- n. Por ejemplo,\n--    \u03bb> creaArbol 2\n--    Nodo (Nodo (Hoja ()) (Hoja ())) (Nodo (Hoja ()) (Hoja ()))\n-- ---------------------------------------------------------------------\n\ncreaArbol :: Int -> Arbol ()\ncreaArbol h\n  | h <= 0    = Hoja ()\n  | otherwise = let x = creaArbol (h - 1) in Nodo x x\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 38. Definir la funci\u00f3n\n--    injerta :: Arbol (Arbol a) -> Arbol a\n-- tal que (injerta t) es el \u00e1rbol obtenido sustituyendo cada hoja por el\n-- \u00e1rbol que contiene. Por ejemplo,\n--    > injerta (Nodo (Hoja (Hoja 'x')) (Hoja (Nodo (Hoja 'y') (Hoja 'z'))))\n--    Nodo (Hoja 'x') (Nodo (Hoja 'y') (Hoja 'z'))\n-- ---------------------------------------------------------------------\n\ninjerta :: Arbol (Arbol a) -> Arbol a\ninjerta (Hoja t)   = t\ninjerta (Nodo l r) = Nodo (injerta l) (injerta r)\n\n-- ---------------------------------------------------------------------\n-- \u00a7 Expresiones                                                      --\n-- ---------------------------------------------------------------------\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 39. Definir el tipo de las expresiones aritm\u00e9ticas formada\n-- por\n-- + literales (p.e. Lit 7),\n-- + sumas (p.e. Suma (Lit 7) (Suma (Lit 3) (Lit 5)))\n-- + opuestos (p.e. Op (Suma (Op (Lit 7)) (Suma (Lit 3) (Lit 5))))\n-- + expresiones condicionales (p.e. (SiCero (Lit 3) (Lit 4) (Lit 5))\n-- ---------------------------------------------------------------------\n\ndata Expr =\n    Lit Int\n  | Suma Expr Expr\n  | Op Expr\n  | SiCero Expr Expr Expr\n  deriving (Eq, Show)\n\n-- En los ejemplos se usar\u00e1n las siguientes expresiones:\nexpr1, expr2 :: Expr\nexpr1 = Op (Suma (Lit 3) (Lit 5))\nexpr2 = SiCero expr1 (Lit 1) (Lit 0)\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 40. Definir la funci\u00f3n\n--    valor :: Expr -> Int\n-- tal que (valor e) es el valor de la expresi\u00f3n e (donde el valor de\n-- (SiCero e e1 e2) es el valor de e1 si el valor de e es cero y el es\n-- el valor de e2, en caso contrario). Por ejemplo,\n--    valor expr1  ==  -8\n--    valor expr2  ==  0\n-- ---------------------------------------------------------------------\n\nvalor :: Expr -> Int\nvalor (Lit n)        = n\nvalor (Suma x y)     = valor x + valor y\nvalor (Op x)         = - valor x\nvalor (SiCero x y z) | valor x == 0 = valor y\n                     | otherwise    = valor z\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 41. Definir la funci\u00f3n\n--    resta :: Expr -> Expr -> Expr\n-- tal que (resta e1 e2) es la expresi\u00f3n correspondiente a la diferencia\n-- de e1 y e2. Por ejemplo,\n--    resta (Lit 42) (Lit 2)  ==  Suma (Lit 42) (Op (Lit 2))\n-- ---------------------------------------------------------------------\n\nresta :: Expr -> Expr -> Expr\nresta x y = Suma x (Op y)\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 42. Definir el procedimiento\n--    exprArbitraria :: Int -> Gen Expr\n-- tal que (exprArbitraria n) es una expresi\u00f3n aleatoria de tama\u00f1o n. Por\n-- ejemplo,\n--    \u03bb> sample (exprArbitraria 3)\n--    Op (Op (Lit 0))\n--    SiCero (Lit 0) (Lit (-2)) (Lit (-1))\n--    Op (Suma (Lit 3) (Lit 0))\n--    Op (Lit 5)\n--    Op (Lit (-1))\n--    Op (Op (Lit 9))\n--    Suma (Lit (-12)) (Lit (-12))\n--    Suma (Lit (-9)) (Lit 10)\n--    Op (Suma (Lit 8) (Lit 15))\n--    SiCero (Lit 16) (Lit 9) (Lit (-5))\n--    Suma (Lit (-3)) (Lit 1)\n-- ---------------------------------------------------------------------\n\nexprArbitraria :: Int -> Gen Expr\nexprArbitraria n\n  | n <= 1 = Lit <$> arbitrary\n  | otherwise = oneof\n                [ Lit <$> arbitrary\n                , let m = div n 2\n                  in Suma <$> exprArbitraria m <*> exprArbitraria m\n                , Op <$> exprArbitraria (n - 1)\n                , let m = div n 3\n                  in SiCero <$> exprArbitraria m\n                            <*> exprArbitraria m\n                            <*> exprArbitraria m\n                ]\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 43. Declarar Expr como subclase de Arbitraria usando el\n-- generador exprArbitraria-\n-- ---------------------------------------------------------------------\n\ninstance Arbitrary Expr where\n  arbitrary = sized exprArbitraria\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 44. Comprobar con QuickCheck que\n--    valor (resta x y) == valor x - valor y\n-- ---------------------------------------------------------------------\n\n-- La propiedad es\nprop_resta :: Expr -> Expr -> Property\nprop_resta x y =\n  valor (resta x y) === valor x - valor y\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_resta\n--    +++ OK, passed 100 tests.\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 45. Definir la funci\u00f3n\n--    numeroOps :: Expr -> Int\n-- tal que (numeroOps e) es el n\u00famero de operaciones de e. Por ejemplo,\n--    numeroOps (Lit 3)                      ==  0\n--    numeroOps (Suma (Lit 7) (Op (Lit 5)))  ==  2\n-- ---------------------------------------------------------------------\n\nnumeroOps :: Expr -> Int\nnumeroOps (Lit _)        = 0\nnumeroOps (Suma x y)     = 1 + numeroOps x + numeroOps y\nnumeroOps (Op x)         = 1 + numeroOps x\nnumeroOps (SiCero x y z) = 1 + numeroOps x + numeroOps y + numeroOps z\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 46. Definir la funci\u00f3n\n--    cadenaExpr :: Expr -> String\n-- tal que (cadenaExpr e) es la cadena que representa la expresi\u00f3n e. Por\n-- ejemplo,\n--    \u03bb> expr2\n--    SiCero (Op (Suma (Lit 3) (Lit 5))) (Lit 1) (Lit 0)\n--    \u03bb> cadenaExpr expr2\n--    \"(if (- (3 + 5)) == 0 then 1 else 0)\"\n-- ---------------------------------------------------------------------\n\ncadenaExpr :: Expr -> String\ncadenaExpr (Lit n)\n    | n >= 0              = show n\n    | otherwise           = '(' : show n ++ \")\"\ncadenaExpr (Suma x y)     = '(' : cadenaExpr x ++ \" + \" ++ cadenaExpr y ++ \")\"\ncadenaExpr (Op x)         = \"(- \" ++ cadenaExpr x ++ \")\"\ncadenaExpr (SiCero x y z) = \"(if \" ++ cadenaExpr x ++ \" == 0 then \" ++\n                                 cadenaExpr y ++ \" else \" ++\n                                 cadenaExpr z ++ \")\"\n\n-- ---------------------------------------------------------------------\n-- \u00a7 Referencias                                                      --\n-- ---------------------------------------------------------------------\n\n-- Esta relaci\u00f3n de ejercicios es una adaptaci\u00f3n de la de Lars Br\u00fcnjes\n-- \"Datatypes.hs\" https:\/\/bit.ly\/3sGYmYP\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 Tipos de datos algebraicos en Haskell en la que se estudian los tipos abstractos de datos (TAD) tantos los predefinidos (como booleanos, opcionales, pares y listas) como definidos (\u00e1rboles binarios). Se definen funciones sobre los TAD y se verifican propiedades con&#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\/7657"}],"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=7657"}],"version-history":[{"count":2,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/posts\/7657\/revisions"}],"predecessor-version":[{"id":7659,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/posts\/7657\/revisions\/7659"}],"wp:attachment":[{"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/media?parent=7657"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/categories?post=7657"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/tags?post=7657"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}