{"id":7673,"date":"2022-03-11T19:37:21","date_gmt":"2022-03-11T18:37:21","guid":{"rendered":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/?p=7673"},"modified":"2022-03-12T07:45:28","modified_gmt":"2022-03-12T06:45:28","slug":"pfh-ejercicios-de-definiciones-por-plegado","status":"publish","type":"post","link":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/pfh-ejercicios-de-definiciones-por-plegado\/","title":{"rendered":"PFH: Ejercicios de definiciones por plegado"},"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\/35QPKWT\">Definiciones por plegado<\/a> en la que se muestra c\u00f3mo se pueden definir funciones por plegado. Adem\u00e1s, se comparan dichas definiciones con las definiciones recursivas, con acumuladores y con evaluaci\u00f3n impaciente. Finalmente, se define la funci\u00f3n de plegado para los \u00e1rboles binarios y se usa para definir funciones sobre \u00e1rboles.<\/p>\n<p>El contenido de la relaci\u00f3n es el siguiente<br \/>\n<!--more--><\/p>\n<pre lang=\"haskell\">\n{-# LANGUAGE BangPatterns        #-}\n{-# LANGUAGE ScopedTypeVariables #-}\n\nmodule Definiciones_por_plegados where\n\n-- ---------------------------------------------------------------------\n-- Importaci\u00f3n de librer\u00edas auxiliares                                --\n-- ---------------------------------------------------------------------\n\nimport Data.List (foldl')\nimport Test.QuickCheck\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 1. Definir la funci\u00f3n\n--    producto :: Num a => [a] -> a\n-- tal que (producto xs) es el producto de los n\u00fameros de xs. Por\n-- ejemplo,\n--    producto [2,3,5]  ==  30\n-- ---------------------------------------------------------------------\n\n-- 1\u00aa definici\u00f3n\nproducto :: Num a => [a] -> a\nproducto []       = 1\nproducto (x : xs) = x * producto xs\n\n-- 2\u00aa definici\u00f3n\nproducto2 :: Num a => [a] -> a\nproducto2 = foldr (*) 1\n\n-- 3\u00aa definici\u00f3n\nproducto3 :: Num a => [a] -> a\nproducto3 = aux 1\n  where\n    aux :: Num a => a -> [a] -> a\n    aux r []       = r\n    aux r (x : xs) = aux (r * x) xs\n\n-- 4\u00aa definici\u00f3n\nproducto4 :: Num a => [a] -> a\nproducto4 = foldl (*) 1\n\n-- 5\u00aa definici\u00f3n\nproducto5 :: Num a => [a] -> a\nproducto5 = aux 1\n  where\n    aux :: Num a => a -> [a] -> a\n    aux !r []       = r\n    aux !r (x : xs) = aux (r * x) xs\n\n-- 6\u00aa definici\u00f3n\nproducto6 :: Num a => [a] -> a\nproducto6 = foldl' (*) 1\n\n-- 7\u00aa definici\u00f3n\nproducto7 :: Num a => [a] -> a\nproducto7 = product\n\n-- La propiedad de la equivalencia es\nprop_producto :: [Integer] -> Bool\nprop_producto xs =\n  all (== producto xs)\n      [producto2 xs,\n       producto3 xs,\n       producto4 xs,\n       producto5 xs,\n       producto6 xs,\n       producto7 xs]\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_producto\n--    +++ OK, passed 100 tests.\n\n-- La comparaci\u00f3n de eficiencia es\n--    \u03bb> length (show (producto [1..10^5]))\n--    456574\n--    (8.84 secs, 12,233,346,144 bytes)\n--    \u03bb> length (show (producto2 [1..10^5]))\n--    456574\n--    (8.86 secs, 12,224,409,544 bytes)\n--    \u03bb> length (show (producto3 [1..10^5]))\n--    456574\n--    (8.20 secs, 11,331,830,408 bytes)\n--    \u03bb> length (show (producto4 [1..10^5]))\n--    456574\n--    (8.49 secs, 11,322,997,552 bytes)\n--    \u03bb> length (show (producto5 [1..10^5]))\n--    456574\n--    (1.31 secs, 11,328,586,376 bytes)\n--    \u03bb> length (show (producto6 [1..10^5]))\n--    456574\n--    (1.21 secs, 11,315,687,984 bytes)\n--    \u03bb> length (show (producto7 [1..10^5]))\n--    456574\n--    (8.23 secs, 11,322,997,504 bytes)\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 2. Definir la funci\u00f3n\n--    inversa :: [a] -> [a]\n-- tal que (inversa xs) es la inversa de xs. Por ejemplo,\n--    inversa [3,2,5]  ==  [5,2,3]\n-- ---------------------------------------------------------------------\n\n-- 1\u00aa definici\u00f3n\ninversa1 :: [a] -> [a]\ninversa1 []       = []\ninversa1 (x : xs) = inversa1 xs ++ [x]\n\n-- 2\u00aa definici\u00f3n\ninversa2 :: [a] -> [a]\ninversa2 = foldr (\\x r -> r ++ [x]) []\n\n-- 3\u00aa definici\u00f3n\ninversa3 :: [a] -> [a]\ninversa3 = aux []\n  where\n    aux :: [a] -> [a] -> [a]\n    aux r [] = r\n    aux r (x : xs) = aux (x : r) xs\n\n-- 4\u00aa definici\u00f3n\ninversa4 :: [a] -> [a]\ninversa4 = foldl (flip (:)) []\n\n-- 5\u00aa definici\u00f3n\ninversa5 :: [a] -> [a]\ninversa5 = aux []\n  where\n    aux :: [a] -> [a] -> [a]\n    aux !r [] = r\n    aux !r (x : xs) = aux (x : r) xs\n\n-- 6\u00aa definici\u00f3n\ninversa6 :: [a] -> [a]\ninversa6 = foldl' (flip (:)) []\n\n-- 7\u00aa definici\u00f3n\ninversa7 :: [a] -> [a]\ninversa7 = reverse\n\n-- La propiedad de equivalencia de las definiciones es\nprop_inversa :: [Integer] -> Bool\nprop_inversa xs =\n  all (== inversa1 xs)\n      [inversa2 xs,\n       inversa3 xs,\n       inversa4 xs,\n       inversa5 xs,\n       inversa6 xs,\n       inversa7 xs]\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_inversa\n--    +++ OK, passed 100 tests.\n\n-- La comparaci\u00f3n de eficiencia es\n--    \u03bb> length (inversa1 [1..2*10^4])\n--    20000\n--    (4.98 secs, 17,512,973,536 bytes)\n--    \u03bb> length (inversa2 [1..2*10^4])\n--    20000\n--    (5.00 secs, 17,511,525,848 bytes)\n--    \u03bb> length (inversa3 [1..2*10^4])\n--    20000\n--    (0.02 secs, 4,342,376 bytes)\n--    \u03bb> length (inversa4 [1..2*10^4])\n--    20000\n--    (0.03 secs, 3,062,336 bytes)\n--    \u03bb> length (inversa4 [1..2*10^4])\n--    20000\n--    (0.03 secs, 3,062,336 bytes)\n--    \u03bb> length (inversa6 [1..2*10^4])\n--    20000\n--    (0.03 secs, 2,262,336 bytes)\n--    \u03bb> length (inversa7 [1..2*10^4])\n--    20000\n--    (0.01 secs, 2,262,336 bytes)\n--\n--    \u03bb> length (inversa4 [1..5*10^6])\n--    5000000\n--    (0.74 secs, 680,343,848 bytes)\n--    \u03bb> length (inversa5 [1..5*10^6])\n--    5000000\n--    (1.50 secs, 1,000,343,888 bytes)\n--    \u03bb> length (inversa6 [1..5*10^6])\n--    5000000\n--    (0.51 secs, 480,343,848 bytes)\n--    \u03bb> length (inversa7 [1..5*10^6])\n--    5000000\n--    (0.48 secs, 480,343,848 bytes)\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 3. Definir la funci\u00f3n\n--    coge :: Int -> [a] -> [a]\n-- tal que (coge n xs) es la lista formada por los n primeros elementos\n-- de xs. Por ejemplo,\n--    coge 3 \"Betis\"  ==  \"Bet\"\n--    coge 9 \"Betis\"  ==  \"Betis\"\n-- ---------------------------------------------------------------------\n\n-- 1\u00aa definici\u00f3n\ncoge :: Int -> [a] -> [a]\ncoge n _ | n <= 0 = []\ncoge _ []         = []\ncoge n (x : xs)   = x : coge (n - 1) xs\n\n-- 2\u00aa definici\u00f3n\ncoge2 :: Int -> [a] -> [a]\ncoge2 = flip aux\n  where\n    aux :: [a] -> Int -> [a]\n    aux = foldr f (const [])\n\n    f :: a -> (Int -> [a]) -> Int -> [a]\n    f x r n\n      | n <= 0    = []\n      | otherwise = x : r (n - 1)\n\n-- 3\u00aa definici\u00f3n\ncoge3 :: Int -> [a] -> [a]\ncoge3 = take\n\n-- La propiedad de equivalencia de las definiciones es\nprop_coge :: Int -> [Int] -> Bool\nprop_coge n xs =\n  all (== coge n xs)\n      [coge2 n xs,\n       coge3 n xs]\n\n-- La comprobaci\u00f3n es\n--    \u03bb> quickCheck prop_coge\n--    +++ OK, passed 100 tests.\n\n-- La comparaci\u00f3n de eficiencia es\n--    \u03bb> length (coge (3*10^6) [1..])\n--    3000000\n--    (1.85 secs, 984,343,920 bytes)\n--    \u03bb> length (coge2 (3*10^6) [1..])\n--    3000000\n--    (1.76 secs, 1,200,344,192 bytes)\n--    \u03bb> length (coge3 (3*10^6) [1..])\n--    3000000\n--    (0.08 secs, 384,343,800 bytes)\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 4. Definir la funci\u00f3n\n--    nFoldl :: forall a b. (b -> a -> b) -> b -> [a] -> b\n-- tal que (nFoldl f e xs) pliega xs de izquierda a derecha usando el\n-- operador f y el valor inicial e. Por ejemplo,\n--    nFoldl (-) 20 [2,5,3]  ==  10\n-- ---------------------------------------------------------------------\n\n-- 1\u00aa definici\u00f3n\nnFoldl :: forall a b. (b -> a -> b) -> b -> [a] -> b\nnFoldl _ e []       = e\nnFoldl f e (x : xs) = nFoldl f (f e x) xs\n\n-- 2\u00aa definici\u00f3n\nnFoldl2 :: forall a b. (b -> a -> b) -> b -> [a] -> b\nnFoldl2 f e xs = aux xs e\n  where\n    aux :: [a] -> b -> b\n    aux = foldr g id\n\n    g :: a -> (b -> b) -> b -> b\n    g a h b = h (f b a)\n\n-- 3\u00aa definici\u00f3n\nnFoldl3 :: forall a b. (b -> a -> b) -> b -> [a] -> b\nnFoldl3 = foldl\n\n-- Comparaci\u00f3n de eficiencia\n--    \u03bb> nFoldl min 0 [1..3*10^6]\n--    0\n--    (1.62 secs, 778,190,584 bytes)\n--    \u03bb> nFoldl2 min 0 [1..3*10^6]\n--    0\n--    (1.61 secs, 826,190,736 bytes)\n--    \u03bb> nFoldl3 min 0 [1..3*10^6]\n--    0\n--    (1.08 secs, 535,732,976 bytes)\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 5. 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 6. 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 7. 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 8. 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 9. 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 10. Declarar el tipo Arbol una instancia de la clase\n-- Foldable.\n-- ---------------------------------------------------------------------\n\ninstance Foldable Arbol where\n  foldr = foldrArbol\n\n-- ---------------------------------------------------------------------\n-- Ejercicio 11. 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 12. 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-- La propiedad es de equivalencia de las definiciones 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-- Ejercicio 13. 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 Definiciones por plegado en la que se muestra c\u00f3mo se pueden definir funciones por plegado. Adem\u00e1s, se comparan dichas definiciones con las definiciones recursivas, con acumuladores y con evaluaci\u00f3n impaciente. Finalmente, se define la funci\u00f3n de plegado para los \u00e1rboles binarios&#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\/7673"}],"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=7673"}],"version-history":[{"count":3,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/posts\/7673\/revisions"}],"predecessor-version":[{"id":7684,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/posts\/7673\/revisions\/7684"}],"wp:attachment":[{"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/media?parent=7673"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/categories?post=7673"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.glc.us.es\/~jalonso\/vestigium\/wp-json\/wp\/v2\/tags?post=7673"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}