-- I1M 2021-22: Rel_8_sol.hs
-- Funciones de orden superior y definiciones por plegados.
-- Departamento de Ciencias de la Computación e I.A.
-- Universidad de Sevilla
-- =====================================================================
-- ---------------------------------------------------------------------
-- Introducción --
-- ---------------------------------------------------------------------
-- Esta relación tiene contiene ejercicios con funciones de orden
-- superior y definiciones por plegado correspondientes al tema 7
-- http://www.cs.us.es/~jalonso/cursos/i1m/temas/tema-7.html
-- ---------------------------------------------------------------------
-- Importación de librerías auxiliares --
-- ---------------------------------------------------------------------
import Test.QuickCheck
-- ---------------------------------------------------------------------
-- Ejercicio 1. Definir la función
-- segmentos :: (a -> Bool) -> [a] -> [a]
-- tal que (segmentos p xs) es la lista de los segmentos de xs cuyos
-- elementos verifican la propiedad p. Por ejemplo,
-- segmentos even [1,2,0,4,9,6,4,5,7,2] == [[2,0,4],[6,4],[2]]
-- segmentos odd [1,2,0,4,9,6,4,5,7,2] == [[1],[9],[5,7]]
-- ---------------------------------------------------------------------
segmentos :: (a -> Bool) -> [a] -> [[a]]
segmentos _ [] = []
segmentos p (x:xs)
| p x = takeWhile p (x:xs) : segmentos p (dropWhile p xs)
| otherwise = segmentos p xs
-- ---------------------------------------------------------------------
-- Ejercicio 2.1. Definir, por comprensión, la función
-- relacionadosC :: (a -> a -> Bool) -> [a] -> Bool
-- tal que (relacionadosC r xs) se verifica si para todo par (x,y) de
-- elementos consecutivos de xs se cumple la relación r. Por ejemplo,
-- relacionadosC (<) [2,3,7,9] == True
-- relacionadosC (<) [2,3,1,9] == False
-- ---------------------------------------------------------------------
relacionadosC :: (a -> a -> Bool) -> [a] -> Bool
relacionadosC r xs = and [r x y | (x,y) <- zip xs (tail xs)]
-- ---------------------------------------------------------------------
-- Ejercicio 2.2. Definir, por recursión, la función
-- relacionadosR :: (a -> a -> Bool) -> [a] -> Bool
-- tal que (relacionadosR r xs) se verifica si para todo par (x,y) de
-- elementos consecutivos de xs se cumple la relación r. Por ejemplo,
-- relacionadosR (<) [2,3,7,9] == True
-- relacionadosR (<) [2,3,1,9] == False
-- ---------------------------------------------------------------------
relacionadosR :: (a -> a -> Bool) -> [a] -> Bool
relacionadosR r (x:y:zs) = r x y && relacionadosR r (y:zs)
relacionadosR _ _ = True
-- ---------------------------------------------------------------------
-- Ejercicio 3.1. Definir la función
-- agrupa :: Eq a => [[a]] -> [[a]]
-- tal que (agrupa xss) es la lista de las listas obtenidas agrupando
-- los primeros elementos, los segundos, ... Por ejemplo,
-- agrupa [[1..6],[7..9],[10..20]] == [[1,7,10],[2,8,11],[3,9,12]]
-- agrupa [] == []
-- ---------------------------------------------------------------------
agrupa :: Eq a => [[a]] -> [[a]]
agrupa [] = []
agrupa xss
| [] `elem` xss = []
| otherwise = primeros xss : agrupa (restos xss)
where primeros = map head
restos = map tail
-- ---------------------------------------------------------------------
-- Ejercicio 3.2. Comprobar con QuickChek que la longitud de todos los
-- elementos de (agrupa xs) es igual a la longitud de xs.
-- ---------------------------------------------------------------------
-- La propiedad es
prop_agrupa :: [[Int]] -> Bool
prop_agrupa xss =
and [length xs == n | xs <- agrupa xss]
where n = length xss
-- La comprobación es
-- ghci> quickCheck prop_agrupa
-- +++ OK, passed 100 tests.
comprueba_agrupa :: IO ()
comprueba_agrupa =
quickCheck prop_agrupa
-- ---------------------------------------------------------------------
-- Ejercicio 4.1. Definir, por recursión, la función
-- concatR :: [[a]] -> [a]
-- tal que (concatR xss) es la concatenación de las listas de xss. Por
-- ejemplo,
-- concatR [[1,3],[2,4,6],[1,9]] == [1,3,2,4,6,1,9]
-- ---------------------------------------------------------------------
concatR :: [[a]] -> [a]
concatR [] = []
concatR (xs:xss) = xs ++ concatR xss
-- ---------------------------------------------------------------------
-- Ejercicio 5.1. Definir, por comprensión, la función
-- filtraAplicaC :: (a -> b) -> (a -> Bool) -> [a] -> [b]
-- tal que (filtraAplicaC f p xs) es la lista obtenida aplicándole a los
-- elementos de xs que cumplen el predicado p la función f. Por ejemplo,
-- filtraAplicaC (4+) (<3) [1..7] => [5,6]
-- ---------------------------------------------------------------------
filtraAplicaC :: (a -> b) -> (a -> Bool) -> [a] -> [b]
filtraAplicaC f p xs = [f x | x <- xs, p x]
-- ---------------------------------------------------------------------
-- Ejercicio 5.2. Definir, usando map y filter, la función
-- filtraAplicaMF :: (a -> b) -> (a -> Bool) -> [a] -> [b]
-- tal que (filtraAplicaMF f p xs) es la lista obtenida aplicándole a los
-- elementos de xs que cumplen el predicado p la función f. Por ejemplo,
-- filtraAplicaMF (4+) (<3) [1..7] => [5,6]
-- ---------------------------------------------------------------------
filtraAplicaMF :: (a -> b) -> (a -> Bool) -> [a] -> [b]
filtraAplicaMF f p xs = map f (filter p xs)
-- ---------------------------------------------------------------------
-- Ejercicio 5.3. Definir, por recursión, la función
-- filtraAplicaR :: (a -> b) -> (a -> Bool) -> [a] -> [b]
-- tal que (filtraAplicaR f p xs) es la lista obtenida aplicándole a los
-- elementos de xs que cumplen el predicado p la función f. Por ejemplo,
-- filtraAplicaR (4+) (<3) [1..7] => [5,6]
-- ---------------------------------------------------------------------
filtraAplicaR :: (a -> b) -> (a -> Bool) -> [a] -> [b]
filtraAplicaR _ _ [] = []
filtraAplicaR f p (x:xs) | p x = f x : filtraAplicaR f p xs
| otherwise = filtraAplicaR f p xs
-- ---------------------------------------------------------------------
-- Ejercicio 6.1. Definir, mediante recursión, la función
-- maximumR :: Ord a => [a] -> a
-- tal que (maximumR xs) es el máximo de la lista xs. Por ejemplo,
-- maximumR [3,7,2,5] == 7
-- maximumR ["todo","es","falso"] == "todo"
-- maximumR ["menos","alguna","cosa"] == "menos"
--
-- Nota: La función maximumR es equivalente a la predefinida maximum.
-- ---------------------------------------------------------------------
maximumR :: Ord a => [a] -> a
maximumR [x] = x
maximumR (x:y:ys) = max x (maximumR (y:ys))
maximumR _ = error "Imposible"
-- ---------------------------------------------------------------------
-- Ejercicio 6.2. La función de plegado foldr1 está definida por
-- foldr1 :: (a -> a -> a) -> [a] -> a
-- foldr1 _ [x] = x
-- foldr1 f (x:xs) = f x (foldr1 f xs)
--
-- Definir, mediante plegado con foldr1, la función
-- maximumP :: Ord a => [a] -> a
-- tal que (maximumR xs) es el máximo de la lista xs. Por ejemplo,
-- maximumP [3,7,2,5] == 7
-- maximumP ["todo","es","falso"] == "todo"
-- maximumP ["menos","alguna","cosa"] == "menos"
--
-- Nota: La función maximumP es equivalente a la predefinida maximum.
-- ---------------------------------------------------------------------
maximumP :: Ord a => [a] -> a
maximumP = foldr1 max
-- ---------------------------------------------------------------------
-- Ejercicio 7.1. Definir, usando foldr, la función
-- concatP :: [[a]] -> [a]
-- tal que (concatP xss) es la concatenación de las listas de xss. Por
-- ejemplo,
-- concatP [[1,3],[2,4,6],[1,9]] == [1,3,2,4,6,1,9]
-- ---------------------------------------------------------------------
concatP :: [[a]] -> [a]
concatP = foldr (++) []
-- ---------------------------------------------------------------------
-- Ejercicio 7.2. Comprobar con QuickCheck que la funciones concatR,
-- concatP y concat son equivalentes.
-- ---------------------------------------------------------------------
-- La propiedad es
prop_concat :: [[Int]] -> Bool
prop_concat xss =
concatR xss == ys && concatP xss == ys
where ys = concat xss
-- La comprobación es
-- ghci> quickCheck prop_concat
-- +++ OK, passed 100 tests.
-- ---------------------------------------------------------------------
-- Ejercicio 7.3. Comprobar con QuickCheck que la longitud de
-- (concatP xss) es la suma de las longitudes de los elementos de xss.
-- ---------------------------------------------------------------------
-- La propiedad es
prop_longConcat :: [[Int]] -> Bool
prop_longConcat xss =
length (concatP xss) == sum [length xs | xs <- xss]
-- La comprobación es
-- ghci> quickCheck prop_longConcat
-- +++ OK, passed 100 tests.
-- ---------------------------------------------------------------------
-- Ejercicio 8. Definir, por plegado, la función
-- filtraAplicaP :: (a -> b) -> (a -> Bool) -> [a] -> [b]
-- tal que (filtraAplicaP f p xs) es la lista obtenida aplicándole a los
-- elementos de xs que cumplen el predicado p la función f. Por ejemplo,
-- filtraAplicaP (4+) (<3) [1..7] => [5,6]
-- ---------------------------------------------------------------------
filtraAplicaP :: (a -> b) -> (a -> Bool) -> [a] -> [b]
filtraAplicaP f p = foldr g []
where g x y | p x = f x : y
| otherwise = y
-- La definición por plegado usando lambda es
filtraAplicaP2 :: (a -> b) -> (a -> Bool) -> [a] -> [b]
filtraAplicaP2 f p =
foldr (\x y -> if p x then f x : y else y) []
-- ---------------------------------------------------------------------
-- Ejercicio 9.1. Definir, con la función all, la función
-- relacionadosA :: (a -> a -> Bool) -> [a] -> Bool
-- tal que (relacionadosA r xs) se verifica si para todo par (x,y) de
-- elementos consecutivos de xs se cumple la relación r. Por ejemplo,
-- relacionadosA (<) [2,3,7,9] == True
-- relacionadosA (<) [2,3,1,9] == False
-- ---------------------------------------------------------------------
-- 1ª solución
-- Redefinir la relación 'r' con 'rpar' para que se aplique a pares
relacionadosA :: (a -> a -> Bool) -> [a] -> Bool
relacionadosA r xs = all rpar (zip xs (tail xs))
where rpar (x,y) = r x y
-- 2ª solución. La función uncurry hace esa conversión, de función
-- con dos argumentos a función que recibe un par
relacionadosA' :: (a -> a -> Bool) -> [a] -> Bool
relacionadosA' r xs = all (uncurry r) (zip xs (tail xs))
-- ---------------------------------------------------------------------
-- Ejercicio 9.2. Definir, con la función foldr, la función
-- relacionadosP :: (a -> a -> Bool) -> [a] -> Bool
-- tal que (relacionadosP r xs) se verifica si para todo par (x,y) de
-- elementos consecutivos de xs se cumple la relación r. Por ejemplo,
-- relacionadosP (<) [2,3,7,9] == True
-- relacionadosP (<) [2,3,1,9] == False
-- ---------------------------------------------------------------------
-- 1ª solución
relacionadosP :: (a -> a -> Bool) -> [a] -> Bool
relacionadosP r xs = foldr rfpar True (zip xs (tail xs))
where rfpar (x,y) b = (r x y) && b
-- 2ª solución, sin usar el zip, y $ es igual que poner paréntesis hasta
-- el final de la línea
relacionadosP' :: (a -> a -> Bool) -> [a] -> Bool
relacionadosP' r xs = snd $ foldr rfpar (last xs,True) (init xs)
where rfpar x (y,b) = (x,(r x y) && b)
-- ---------------------------------------------------------------------
-- Ejercicio 9.3. (Basado en el ejercicio 4 del primer parcial)
-- Una lista se dirá muy creciente si cada elemento es mayor estricto
-- que el triple del anterior.
-- Empleando tan solo (relacionadosA p xs), define el predicado
-- muyCreciente :: [Integer] -> Bool
-- tal que (muyCreciente xs) se verifica si xs es muy creciente. Por
-- ejemplo:
-- muyCreciente [1,5,23,115] == True
-- muyCreciente [1,2,7,14] == False
-- muyCreciente [7] == True
-- muyCreciente [] == True
-- ---------------------------------------------------------------------
muyCreciente :: [Integer] -> Bool
muyCreciente xs = relacionadosA relMuyCreciente xs
where relMuyCreciente a b = b > a*3
![Informática de 1º de Matemáticas [Curso 2021-22, Grupo 2]](/WIKIS/I1M2021G2/resources/assets/logoUS.png)