-- I1M 2021-22:
-- Funciones de orden superior y definiciones por plegados (II)
-- Departamento de Ciencias de la Computación e Inteligencia Artificial
-- Universidad de Sevilla
-- ============================================================================
-- ============================================================================
-- Librerías auxiliares
-- ============================================================================
import Data.Char
import Data.List
import Test.QuickCheck
-- ----------------------------------------------------------------------------
-- Ejercicio 1. Se considera la función
-- resultadoPos :: (a -> Integer) -> [a] -> [a]
-- tal que (resultadoPos f xs) es la lista de los elementos de la lista
-- xs tales que el valor de la función f sobre ellos es positivo. Por ejemplo,
-- resultadoPos head [[-1,2],[-9,4],[2,3]] == [[2,3]]
-- resultadoPos sum [[1,2],[9],[-8,3],[],[3,5]] == [[1,2],[9],[3,5]]
--
-- Define esta función
-- 1) por comprensión,
-- 2) por orden superior,
-- 3) por recursión,
-- 4) por plegado.
-- -----------------------------------------------------------------------------
resultadoPosC :: (a -> Integer) -> [a] -> [a]
resultadoPosO :: (a -> Integer) -> [a] -> [a]
resultadoPosR :: (a -> Integer) -> [a] -> [a]
resultadoPosF :: (a -> Integer) -> [a] -> [a]
resultadoPosC f xs = [x | x <- xs, f x > 0]
resultadoPosO f xs = filter (\ x -> f x > 0) xs
resultadoPosR f [] = []
resultadoPosR f (x:xs) | f x > 0 = x:resultadoPosR f xs
| otherwise = resultadoPosR f xs
resultadoPosF f xs = foldr (\ x y -> if f x > 0 then (x:y) else y) [] xs
prop_resultadoPos :: Eq a => (a -> Integer) -> [a] -> Bool
prop_resultadoPos f xs = resultadoPosC f xs == resultadoPosO f xs &&
resultadoPosC f xs == resultadoPosR f xs &&
resultadoPosC f xs == resultadoPosF f xs
-- Se probaría con
-- λ> quickCheck (prop_resultadoPos sum)
-- +++ OK, passed 100 tests.
-- ----------------------------------------------------------------------------
-- Ejercicio 2. Se considera la función
-- intercala :: Int -> [Int] -> [Int]
-- tal que (intercala y xs) es la lista que resulta de intercalar el elemento
-- y delante de todos los elementos de la lista xs que sean menores que y.
-- Por ejemplo,
-- intercala 5 [1,2,6,3,7,9] == [5,1,5,2,6,5,3,7,9]
-- intercala 5 [6,7,9,8] == [6,7,9,8]
--
-- Define esta función
-- 1) por comprensión,
-- 2) por orden superior,
-- 3) por recursión,
-- 4) por plegado.
-- ----------------------------------------------------------------------------
intercalaC :: Int -> [Int] -> [Int]
intercalaO :: Int -> [Int] -> [Int]
intercalaR :: Int -> [Int] -> [Int]
intercalaF :: Int -> [Int] -> [Int]
intercalaC y xs = concat [if x < y then [y,x] else [x] | x <- xs]
intercalaO y xs = concat (map (\ x -> if x < y then [y,x] else [x]) xs)
intercalaR y [] = []
intercalaR y (x:xs) | x < y = y:x:intercalaR y xs
| otherwise = x:intercalaR y xs
intercalaF y xs = foldr (\ x l -> if x < y then y:x:l else x:l ) [] xs
prop_intercala :: Int -> [Int] -> Bool
prop_intercala y xs = intercalaC y xs == intercalaO y xs &&
intercalaC y xs == intercalaR y xs &&
intercalaC y xs == intercalaF y xs
-- ----------------------------------------------------------------------------
-- Ejercicio 3. Se considera la función
-- dec2ent :: [Integer] -> Integer
-- tal que (dec2ent xs) es el número entero cuyas cifras ordenadas son los
-- elementos de la lista xs. Por ejemplo,
-- dec2ent [2,3,4,5] == 2345
-- dec2ent [1..9] == 123456789
--
-- Defie esta función
-- 1) por comprensión,
-- 2) por orden superior,
-- 3) por recursión,
-- 4) por plegado.
-- ----------------------------------------------------------------------------
dec2entC :: [Integer] -> Integer
dec2entO :: [Integer] -> Integer
dec2entR :: [Integer] -> Integer
dec2entF :: [Integer] -> Integer
dec2entC xs = read [head (show x) | x <- xs]
dec2entO xs = read (map (head.show) xs)
dec2entR [] = 0
dec2entR (x:xs) = x*10^(length xs) + dec2entR xs
dec2entF xs = foldl (\ x y -> 10*x + y) 0 xs
prop_dec2ent :: [Integer] -> Property
prop_dec2ent xs = (all (\ x -> (x>0) && (x<10)) xs) && length xs > 0 ==>
dec2entC xs == dec2entO xs &&
dec2entC xs == dec2entR xs &&
dec2entC xs == dec2entF xs
-- ----------------------------------------------------------------------------
-- Ejercicio 4. Se considera la función
-- diferencia :: Eq a => [a] -> [a] -> [a]
-- tal que (diferencia xs ys) es la diferencia entre los conjuntos xs e
-- ys; es decir, el conjunto de los elementos de la lista xs que no se
-- encuentran en la lista ys. Por ejemplo,
-- diferencia [2,3,5,6] [5,2,7] == [3,6]
-- diferencia [1,3,5,7] [2,4,6] == [1,3,5,7]
-- diferencia [1,3] [1..9] == []
--
-- Define esta función
-- 1) por comprensión,
-- 2) por orden superior,
-- 3) por recursión,
-- 4) por plegado.
-- ----------------------------------------------------------------------------
diferenciaC :: Eq a => [a] -> [a] -> [a]
diferenciaO :: Eq a => [a] -> [a] -> [a]
diferenciaR :: Eq a => [a] -> [a] -> [a]
diferenciaF :: Eq a => [a] -> [a] -> [a]
diferenciaC xs ys = [x | x <- xs, not (elem x ys) ]
diferenciaO xs ys = filter (\ x -> not (elem x ys)) xs
diferenciaR [] ys = []
diferenciaR (x:xs) ys | elem x ys = diferenciaR xs ys
| otherwise = x:diferenciaR xs ys
diferenciaF xs ys = foldr (\ x l -> if elem x ys then l else x:l) [] xs
prop_diferencia :: Eq a => [a] -> [a] -> Bool
prop_diferencia xs ys = diferenciaC xs ys == diferenciaO xs ys &&
diferenciaC xs ys == diferenciaR xs ys &&
diferenciaC xs ys == diferenciaF xs ys
-- ----------------------------------------------------------------------------
-- Ejercicio 5. Se considera la función
-- primerosYultimos :: [[a]] -> ([a],[a])
-- tal que (primerosYultimos xss) es el par formado por la lista de los
-- primeros elementos de las listas no vacías de xss y la lista de los
-- últimos elementos de las listas no vacías de xss. Por ejemplo,
-- primerosYultimos [[1,2],[5,3,4],[],[9]] == ([1,5,9],[2,4,9])
-- primerosYultimos [[1,2],[1,2,3],[1..4]] == ([1,1,1],[2,3,4])
--
-- Define esta función
-- 1) por comprensión,
-- 2) por orden superior,
-- 3) por recursión,
-- 4) por plegado.
-- ----------------------------------------------------------------------------
primerosYultimosC :: [[a]] -> ([a],[a])
primerosYultimosO :: [[a]] -> ([a],[a])
primerosYultimosR :: [[a]] -> ([a],[a])
primerosYultimosF :: [[a]] -> ([a],[a])
primerosYultimosC xss = ([head xs | xs <- xss, length xs > 0],[last xs | xs <- xss, length xs > 0])
primerosYultimosO xss = (map head (filter (not.null) xss),map last (filter (not.null) xss))
primerosYultimosR xss = (primerosR xss, ultimosR xss)
primerosR :: [[a]] -> [a]
primerosR [] = []
primerosR ([]:xss) = primerosR xss
primerosR (xs:xss) = head xs:primerosR xss
ultimosR :: [[a]] -> [a]
ultimosR [] = []
ultimosR ([]:xss) = primerosR xss
ultimosR (xs:xss) = last xs:primerosR xss
primerosYultimosF xss = (foldr (\ xs l -> if not (null xs) then (head xs):l else l) [] xss,
foldr (\ xs l -> if not (null xs) then (last xs):l else l) [] xss)
prop_primerosYultimos :: Eq a => [[a]] -> Bool
prop_primerosYultimos xss = primerosYultimosC xss == primerosYultimosO xss &&
primerosYultimosC xss == primerosYultimosR xss &&
primerosYultimosC xss == primerosYultimosF xss
-- ----------------------------------------------------------------------------
-- Ejercicio 6. Una lista hermanada es una lista de números estrictamente
-- positivos en la que cada elemento tiene algún factor primo en común con el
-- siguiente, en caso de que exista, o alguno de los dos es un 1. Por ejemplo,
-- [2,6,3,9,1,5] es una lista hermanada.
-- Se considera la función
-- hermanada :: [Int] -> Bool
-- tal que (hermanada xs) comprueba que la lista xs es hermanada según la
-- definición anterior. Por ejemplo,
-- hermanada [2,6,3,9,1,5] == True
-- hermanada [2,3,5] == False
--
-- Se pide definir esta función
-- 1) por comprensión,
-- 2) por orden superior,
-- 3) por recursión,
-- 4) por plegado.
-- ----------------------------------------------------------------------------
-- Nota: Usa la función 'gcd'
-- ----------------------------------------------------------------------------
hermanadaC :: [Int] -> Bool
hermanadaO :: [Int] -> Bool
hermanadaR :: [Int] -> Bool
hermanadaF :: [Int] -> Bool
hermanadaC xs = and [x == 1 || y == 1 || gcd x y > 1 | (x,y) <- zip xs (tail xs)]
hermanadaO xs = all (\ (x,y) -> x == 1 || y == 1 || gcd x y > 1) (zip xs (tail xs))
hermanadaR [] = True
hermanadaR (x:[]) = True
hermanadaR (x:y:xs) = (x == 1 || y == 1 || gcd x y > 1) && hermanadaR (y:xs)
hermanadaF xs = foldr (\ (x,y) l -> (x == 1 || y == 1 || gcd x y > 1) && l) True (zip xs (tail xs))
prop_hermanadas :: [Int] -> Property
prop_hermanadas xs = all (>0) xs ==> hermanadaC xs == hermanadaO xs &&
hermanadaC xs == hermanadaR xs &&
hermanadaC xs == hermanadaF xs
-- ----------------------------------------------------------------------------
-- Ejercicio 7. Un elemento de una lista es permanente si ninguno de los que
-- vienen a continuación en la lista es mayor que él. Consideramos la función
-- permanentes :: [Int] -> [Int]
-- tal que (permanentes xs) es la lista de los elementos permanentes de la
-- lista xs. Por ejemplo,
-- permanentes [80,1,7,8,4] == [80,8,4]
-- Se pide definir esta función
-- 1) por comprensión,
-- 2) por orden superior,
-- 3) por recursión,
-- 4) por plegado.
-- ---------------------------------------------------------------------------
-- Nota: Usa la función 'tails' de Data.List.
-- ----------------------------------------------------------------------------
permanenteC :: [Int] -> [Int]
permanenteO :: [Int] -> [Int]
permanenteR :: [Int] -> [Int]
permanenteF :: [Int] -> [Int]
permanenteC xs = [x | (x,y) <- zip xs (tail (tails xs)), all (x>) y]
permanenteO xs = map fst (filter (\ (x,y) -> all (x>) y) (zip xs (tail (tails xs))))
permanenteR [] = []
permanenteR (x:xs) | all (x>) xs = x:permanenteR xs
| otherwise = permanenteR xs
permanenteF xs = foldr (\ (x,y) l -> if all (x>) y then x:l else l) [] (zip xs (tail (tails xs)))
prop_permanente :: [Int] -> Bool
prop_permanente xs = permanenteC xs == permanenteO xs &&
permanenteC xs == permanenteR xs &&
permanenteC xs == permanenteF xs
-- ---------------------------------------------------------------------
-- Ejercicio 8. Un número entero positivo n es muy primo si es n primo
-- y todos los números que resultan de ir suprimimiendo la última cifra
-- también son primos. Por ejemplo, 7193 es muy primo pues los números
-- 7193, 719, 71 y 7 son todos primos.
--
-- Define la función
-- muyPrimo :: Integer -> Bool
-- que (muyPrimo n) se verifica si n es muy primo. Por ejemplo,
-- muyPrimo 7193 == True
-- muyPrimo 71932 == False
-- --------------------------------------------------------------------
factores :: Int -> [Int]
factores n = [x | x <- [1..n], n `mod` x == 0]
primo :: Int -> Bool
primo n = factores n == [1,n]
muyPrimo :: Int -> Bool
muyPrimo n | n < 10 = primo n
| otherwise = primo n && muyPrimo (n `div` 10)
-- ---------------------------------------------------------------------
-- ¿Cuántos números de cinco cifras son muy primos?
-- ---------------------------------------------------------------------
-- El cálculo es:
-- λ> sum [1 | x <- [10000..99999], muyPrimo x]
-- 15
-- (232.02 secs, 94,736,606,016 bytes)
-- ---------------------------------------------------------------------