Relación 8

-- I1M 2021-22: Rel_8.hs (24 de noviembre de 2021)
-- 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]]
-- ---------------------------------------------------------------------
-- Lucía Hernández, Ana Sosa Caballero, Adolfo Sagrera Vivancos
segmentos1 :: (a -> Bool) -> [a] -> [[a]]
segmentos1 p [] = []
segmentos1 p (x:xs) | p x = [a] ++ segmentos1 p (dropWhile p (x:xs)) 
                    | otherwise = segmentos1 p xs
                    where a = takeWhile p (x:xs) 
segmentos :: (a -> Bool) -> [a] -> [[a]]
segmentos p [] = []
segmentos p (x:xs) 
    | p x =  (takeWhile p (x:xs)) : segmentos p (dropWhile p (x:xs)) 
    | otherwise = segmentos p (dropWhile (not.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
-- ---------------------------------------------------------------------

-- Elsa Domínguez, Lucía Hernández, Ana Sosa Caballero
relacionadosC :: (a -> a -> Bool) -> [a] -> Bool
relacionadosC r xs = and [r a b | (a,b) <- zip xs (tail xs)]
--José Manuel García
relacionadosC1 :: (a -> a -> Bool) -> [a] -> Bool
relacionadosC1 r xs = (length [1 | (a,b) <- (zip xs (tail xs)), a `r` b]) ==
                     (length (zip xs (tail xs)))
-- Adolfo Sagrera Vivancos
relacionadosC' :: (a -> a -> Bool) -> [a] -> Bool
relacionadosC' r xs = and [ r x y   | (x,y) <- agrupa1 xs]
agrupa1' xs = 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
-- ---------------------------------------------------------------------

-- Elsa Domínguez, Lucía Hernández, Adolfo Sagrera Vivancos
relacionadosR :: (a -> a -> Bool) -> [a] -> Bool
relacionadosR r [] = True
relacionadosR r [x] = True
relacionadosR r (x:y:zs) = (r x y) && relacionadosR r (y:zs)
--José Manuel García
relacionadosR :: (a -> a -> Bool) -> [a] -> Bool
relacionadosR r [x1,x2] = x1 `r` x2
relacionadosR r (x1:x2:xs) = (x1 `r`x2) && (relacionadosR r (x2:xs))
-- Ana Sosa Caballero
relacionadosR :: (a -> a -> Bool) -> [a] -> Bool
relacionadosR _ [] = False
relacionadosR r [x,y] = r x y
relacionadosR r (x:y:xs) | r x y =  relacionadosR r (y:xs)
                         | otherwise = False
-- ---------------------------------------------------------------------
-- 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 []                        ==  []
-- ---------------------------------------------------------------------

-- Lucía Hernández, Ana Sosa Caballero, Adolfo Sagrera Vivancos
agrupa :: Eq a => [[a]] -> [[a]]
agrupa [] = []
agrupa xss | any null xss =  []
           | otherwise =[map head xss] ++ agrupa (map tail xss) 

-- ---------------------------------------------------------------------
-- Ejercicio 3.2. Comprobar con QuickChek que la longitud de todos los
-- elementos de (agrupa xs) es igual a la longitud de xs.
-- ---------------------------------------------------------------------

-- Elsa Domínguez, Ana Sosa Caballero, Adolfo Sagrera Vivancos
-- La propiedad es
prop_agrupa :: [[Int]] -> Bool
prop_agrupa xss = and [length xs == length xss | xs <- agrupa xss]
          
-- La comprobación es quickCheck prop_agrupa
-- +++ OK, passed 100 tests.

-- ---------------------------------------------------------------------
-- Ejercicio 4. 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]
-- ---------------------------------------------------------------------

-- Elsa Domínguez, Lucía Hernández, Ana Sosa Caballero, Adolfo Sagrera Vivancos
concatR :: [[a]] -> [a]
concatR [] = []
concatR (x:xs) = x ++ concatR xs

-- ---------------------------------------------------------------------
-- 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]
-- ---------------------------------------------------------------------

-- Elsa Domínguez, Lucía Hernández, Ana Sosa Caballero, Adolfo Sagrera Vivancos
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]
-- ---------------------------------------------------------------------

-- Elsa Domínguez, Lucía Hernández, Ana Sosa Caballero
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]
-- ---------------------------------------------------------------------

-- Elsa Domínguez, Ana Sosa Caballero
filtraAplicaR :: (a -> b) -> (a -> Bool) -> [a] -> [b]
filtraAplicaR f p [] = []
filtraAplicaR f p (x:xs) | p x        = [f x] ++ filtraAplicaR f p xs
                         | (not.p) x  = 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.
-- ---------------------------------------------------------------------

-- Elsa Domínguez
maximumR :: Ord a => [a] -> a
maximumR [x] = x
maximumR (x:xs) = max x (maximumR XS)

-- Ana Sosa Caballero
maximumR :: Ord a => [a] -> a
maximumR [x] = x
maximumR (x:xs) | x > (head xs) = maximumR (x:(tail xs))
                | otherwise = maximumR (xs)

-- ---------------------------------------------------------------------
-- 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.
-- ---------------------------------------------------------------------

-- Elsa Domínguez
maximumP :: Ord a => [a] -> a
maximumP xs = foldr1 max xs

-- ---------------------------------------------------------------------
-- 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]
-- ---------------------------------------------------------------------

-- Elsa Domínguez, Ana Sosa Caballero
concatP :: [[a]] -> [a]
concatP xs = foldr (++) [] xs

-- ---------------------------------------------------------------------
-- Ejercicio 7.2. Comprobar con QuickCheck que la funciones concatR,
-- concatP y concat son equivalentes.
-- ---------------------------------------------------------------------

-- Elsa Domínguez, Ana Sosa Caballero
-- La propiedad es
prop_concat :: [[Int]] -> Bool
prop_concat xss = concatR xss == concat xss && concatP xss == concat xss

-- La comprobación es 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.
-- ---------------------------------------------------------------------

-- Elsa Domínguez, Ana Sosa Caballero 
-- La propiedad es
prop_longConcat :: [[Int]] -> Bool
prop_longConcat xss = length (concatP xss) == sum [length xs | xs <- xss]

-- La comprobación es 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]
-- ---------------------------------------------------------------------

-- Elsa Domínguez, Ana Sosa Caballero
filtraAplicaP :: (a -> b) -> (a -> Bool) -> [a] -> [b]
filtraAplicaP f p xs = foldr g [] xs
                     where g x recu | p x        = [f x] ++ recu
                                    | (not.p) x  = recu

--José Manuel García
filtraAplicaPr :: (a -> b) -> (a -> Bool) -> [a] -> [b]
filtraAplicaPr f p xs = foldr fr [] xs
                 where fr x ys | p x = [f x] ++ ys
                               | otherwise = ys

filtraAplicaPl :: (a -> b) -> (a -> Bool) -> [a] -> [b]
filtraAplicaPl f p xs = foldl fl [] xs
                 where fl ys x | p x = ys ++ [f x]
                               | otherwise = ys
 


-- ---------------------------------------------------------------------
-- 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
-- ---------------------------------------------------------------------

relacionadosA :: (a -> a -> Bool) -> [a] -> Bool
relacionadosA = undefined

-- ---------------------------------------------------------------------
-- 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
-- ---------------------------------------------------------------------

relacionadosP :: (a -> a -> Bool) -> [a] -> Bool
relacionadosP = undefined

-- ---------------------------------------------------------------------
-- Ejercicio 9.3. (Basado en el ejercicio 4 del primer parcial del
-- grupo E de 2017)
-- Una lista se dirá muy creciente si cada elemento es mayor estricto
-- que el triple del siguiente. 
-- 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 = undefined