-- I1M 2021-22: Rel_9.hs (01 de diciembre de 2021)
-- 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
-- El siguiente módulo hay que instalarlo:
--cabal install primes
import Data.Numbers.Primes
-- ----------------------------------------------------------------------------
-- 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 (map, filter, ...),
-- 3) por recursión,
-- 4) por plegado (con 'foldr').
-- -----------------------------------------------------------------------------
-- Elsa Domínguez, Adolfo Sagrera Vivancos
resultadoPosC :: (a -> Integer) -> [a] -> [a]
resultadoPosC f xs = [x | x <- xs, f x > 0]
resultadoPosS :: (a -> Integer) -> [a] -> [a]
resultadoPosS f xs = filter g xs
where g x = f x > 0
resultadoPosR :: (a -> Integer) -> [a] -> [a]
resultadoPosR f [] = []
resultadoPosR f (x:xs) | f x > 0 = x : resultadoPosR f xs
| otherwise = resultadoPosR f xs
resultadoPosPR :: (a -> Integer) -> [a] -> [a]
resultadoPosPR f xs = foldr g [] xs
where g prim recu | f prim > 0 = prim : recu
| otherwise = recu
-- ----------------------------------------------------------------------------
-- 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 (map, filter, ...)
-- 3) por recursión,
-- 4) por plegado (con 'foldr').
-- ----------------------------------------------------------------------------
-- Elsa Domínguez, Adolfo Sagrera Vivancos
intercalaC :: Int -> [Int] -> [Int]
intercalaC y xs = concat [if x<y then [y,x] else [x] | x <- xs]
intercalaS :: Int -> [Int] -> [Int]
intercalaS y xs = concat (map f xs)
where f x = if x<y then [y,x] else [x]
intercalaR :: Int -> [Int] -> [Int]
intercalaR y [] = []
intercalaR y (x:xs) | x<y = [y,x] ++ intercalaR y xs
| x>y = [x] ++ intercalaR y xs
intercalaPR :: Int -> [Int] -> [Int]
intercalaPR y xs = foldr g [] xs
where g x recu | x<y = [y,x] ++ recu
| x>y = [x] ++ recu
intercalaA :: Int -> [Int] -> [Int]
intercalaA y xs = aux [] xs
where aux v [] = v
aux v (x:xs) | x<y = aux (v++[y,x]) xs
| otherwise = aux (v++[x]) xs
--José Manuel García
intercala1 :: (Ord a, Num a) => a -> [a] -> [a]
intercala1 n xs = concat [if a < n then [n,a] else [a] | a<-xs]
intercala2 :: (Ord a, Num a) => a -> [a] -> [a]
intercala22 n xs = concat (map f xs)
where f x = if x < n then [n,x] else [x]
intercala3 :: (Ord a, Num a) => a -> [a] -> [a]
intercala3 n [] = []
intercala3 n (x:xs) = (if x < n then [n,x] else [x]) ++ (intercala3 n (xs))
intercala4 n (x:xs) = (foldr (p) [] (x:xs) )
where p prim recu | prim < n = (n : prim:recu)
| otherwise = (prim:recu)
-- ----------------------------------------------------------------------------
-- 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 (map, filter, ...)
-- 3) por recursión,
-- 4) por plegado (con 'foldr').
-- ----------------------------------------------------------------------------
--José Manuel García
dec2ent1 :: [Integer] -> Integer
dec2ent1 xs = read (concat [show x| x <- (sort xs)]) :: Integer
dec2ent2 :: [Integer] -> Integer
dec2ent2 xs = read (concat (map show (sort xs))) :: Integer
dec2ent3 :: [Integer] -> Integer
dec2ent3Aux :: Show a => [a] -> [Char]
dec2ent3Aux [] = []
dec2ent3Aux (x:xs) = (show x) ++ (dec2ent3Aux xs)
dec2ent3 xs = read (dec2ent3Aux (sort xs)) :: Integer
dec2ent4 :: [Integer] -> Integer
dec2ent4 xs = read (concat (foldr f [] (sort xs))) :: Integer
where f prim recu = show prim :recu
-- Adriana Gordillo, Elsa Domínguez
dec2entC :: [Integer] -> Integer
dec2entC xs = sum [x*10^i | (x,i) <- zip xs (reverse [0..length xs-1])]
dec2entS :: [Integer] -> Integer
dec2entS xs = sum (map f (zip xs (reverse [0..length xs-1])))
where f (x,i) = x*10^i
dec2entR :: [Integer] -> Integer
dec2entR [] = 0
dec2entR (x:xs) = x*10^(length xs) + dec2entR xs
dec2entPR :: [Integer] -> Integer
dec2entPR xs = foldr f 0 (zip xs (reverse [0..length xs-1]))
where f (x,i) recu = x*10^i + recu
-- Juan José Calero Vela:
pos :: Integer -> [Integer] -> Integer
pos x [] = 0
pos x (y:xs) = if x==y then 1 else 1 + pos x xs
dec2entC :: [Integer] -> Integer
dec2entC xs = sum [ x*(10^(pos x (reverse xs)-1)) | x<-xs]
-- profesor: solución vista en clase
dec2entS xs = sum (map f (zip xs [n-1,n-2..0]))
where f (x,i) = x * 10^i
n = length xs
--Manuel Alcaide
dec2ent1' :: [Integer] -> Integer
dec2ent1' xs = sum[x*(10^y)|(x,y)<-(zip xs [((length (xs))-1),((length (xs))-2)..0])]
dec2ent2' :: [Integer] -> Integer
dec2ent2' xs = sum (map f (zip xs [((length (xs))-1),((length (xs))-2)..0]))
where f (x,y) = x*(10^y)
dec2ent3' :: [Integer] -> Integer
dec2ent3' [] = 0
dec2ent3' (x:xs) = x*(10^((length (x:xs))-1)) + dec2ent3 xs
dec2ent4' :: [Integer] -> Integer
dec2ent4' xs = foldr f 0 $ zip xs [((length xs)-1),((length xs)-2)..0]
where f (x,p) recu = x*(10^p) + recu
-- Adolfo Sagrera Vivancos
dec2ent xs = sum [ x*10^y | (x,y) <- agrupa xs]
agrupa xs = zip xs (reverse[0..length xs-1])
dec2entOS xs = sum (map f (agrupa xs)) where f (x,y) = x*10^y
dec2entR [] = 0
dec2entR (x:xs) = x*10^(length xs) + dec2entR xs
dec2entP xs = foldr f 0 ys where f (x,y) recu = x*10^y + recu
ys = zip xs (reverse[0..length xs-1])
-- ----------------------------------------------------------------------------
-- 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 (map, filter, ...)
-- 3) por recursión,
-- 4) por plegado (con 'foldr').
-- ----------------------------------------------------------------------------
-- Elsa Domínguez, Adolfo Sagrera Vivancos
diferenciaC :: Eq a => [a] -> [a] -> [a]
diferenciaC xs ys = [x | x <- xs, notElem x ys]
diferenciaS :: Eq a => [a] -> [a] -> [a]
diferenciaS xs ys = concat (map f xs)
where f x | notElem x ys = [x]
| otherwise = []
diferenciaR :: Eq a => [a] -> [a] -> [a]
diferenciaR [] _ = []
diferenciaR (x:xs) ys | notElem x ys = [x] ++ diferenciaR xs ys
| otherwise = diferenciaR xs ys
diferenciaPR :: Eq a => [a] -> [a] -> [a]
diferenciaPR xs ys = foldr g [] xs
where g x recu | notElem x ys = [x] ++ recu
| otherwise = recu
--José Manuel García
diferencia1 :: Eq a => [a] -> [a] -> [a]
diferencia1 xs ys = [x | x <- xs, not (elem x ys) ] -- ++ [y | y <- ys, not (elem y xs) ]
diferencia2 :: Eq a => [a] -> [a] -> [a]
diferencia2 (x:xs) ys = filter f (x:xs)
where f a = not (elem a ys)
diferencia3 :: Eq a => [a] -> [a] -> [a]
diferencia3 [] _ = []
diferencia3 (x:xs) ys | not (elem x ys) = x : (diferencia3 xs ys)
| otherwise = (diferencia3 xs ys)
diferencia4 :: Eq a => [a] -> [a] -> [a]
diferencia4 (x:xs) ys = foldr f [] (x:xs)
where f prim recu | not (elem prim ys) = prim : recu
| otherwise = recu
-- ----------------------------------------------------------------------------
-- 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 (map, filter, ...)
-- 3) por recursión,
-- 4) por plegado (con 'foldr').
-- ----------------------------------------------------------------------------
--José Manuel García, Adolfo Sagrera Vivancos
primerosYultimos1 :: [[a]] -> ([a], [a])
primerosYultimos1 xss = ([head x | x <- xss, not (null x)], [last x | x <- xss, not (null x)])
noVacios :: Foldable t => [t a] -> [t a]
noVacios xss = filter (not.null) xss
primerosYultimos2 :: [[a]] -> ([a], [a])
primerosYultimos2 xss = (map head (noVacios xss), map last (noVacios xss))
primeros3 :: [[a]] -> [a]
primeros3 [] = []
primeros3 (xs:xss) | not (null xs) = (head xs) : (primeros3 xss)
| otherwise = (primeros3 xss)
ultimos3 :: [[a]] -> [a]
ultimos3 [] = []
ultimos3 (xs:xss) | not (null xs) = (last xs) : (ultimos3 xss)
| otherwise = (ultimos3 xss)
primerosYultimos3 :: [[a]] -> ([a], [a])
primerosYultimos3 xss = (primeros3 xss, ultimos3 xss )
primeros4 :: Foldable t => t [a] -> [a]
primeros4 xss = foldr p4 [] xss
where p4 prim recu | not (null prim) = head prim : recu
| otherwise = recu
ultimos4 :: Foldable t => t [a] -> [a]
ultimos4 xss = foldr u4 [] xss
where u4 prim recu | not (null prim) = last prim : recu
| otherwise = recu
primerosYultimos4 :: [[a]] -> ([a], [a])
primerosYultimos4 xss = (primeros4 xss, ultimos4 xss)
-- Elsa Domínguez
primerosYultimosC :: [[a]] -> ([a],[a])
primerosYultimosC xss = (concat [(take 1 xs) | xs <- xss], concat [take 1 (reverse xs) | xs <- xss])
primerosYultimosS :: [[a]] -> ([a],[a])
primerosYultimosS xss = (concat (map (take 1) xss), concat (map (take 1) (map reverse xss)))
primerosYultimosR :: [[a]] -> ([a],[a])
primerosYultimosR xss = (primerosR xss, ultimosR xss)
primerosR [] = []
primerosR (xs:xss) | null xs = primerosR xss
| otherwise = [head xs] ++ primerosR xss
ultimosR [] = []
ultimosR (xs:xss) | null xs = ultimosR xss
| otherwise = [last xs] ++ ultimosR xss
primerosYultimosPR :: [[a]] -> ([a],[a])
primerosYultimosPR xss = (primerosPR xss, ultimosPR xss)
primerosPR xss = foldr f [] xss
where f x recu | null x = recu
| otherwise = [head x] ++ recu
ultimosPR xss = foldr f [] xss
where f x recu | null x = recu
| otherwise = [last x] ++ recu
-- ----------------------------------------------------------------------------
-- 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 (map, filter, ...)
-- 3) por recursión,
-- 4) por plegado (con 'foldr').
-- ----------------------------------------------------------------------------
-- Nota: Usa la función 'gcd'
-- ----------------------------------------------------------------------------
--José Manuel García
primo1 :: Integral a => a -> Bool
primo1 x = [1,x]==[a| a<- [1..x], rem x a == 0] -- Me dice si un número es primo
hermanada1 :: [Int] -> Bool
hermanada1 xs = sum [1 | (a,b) <- (zip xs (tail xs)), (if ((a/=1) && (b/=1))
then ((gcd a b /= 1) && (primo1 (gcd a b)))
else True),
a>0, b>0 ] == (length xs) -1
-- a,b > 0 porque tienen que ser extrictamente positivos
-- ((length xs) - 1) == length (zip xs (tail xs))
primo2 :: Integral a => a -> Bool
primo2 x = filter p2 [1..x] == [1,x]
where p2 b = (rem x b == 0)
hermanada2 :: [Int] -> Bool
hermanada2 xs = and (map prop2 (zip xs (tail xs)))
where prop2 (a,b) = if a>0 && b>0
then (if ((a/=1) && (b/=1)) then ((gcd a b /= 1) && (primo2 (gcd a b))) else True)
else False
primo3 :: Integral a => a -> Bool
primo3 n = noHayNumerosDivisoresDe n 2 (n - 1)
noHayNumerosDivisoresDe :: Integral t => t -> t -> t -> Bool
noHayNumerosDivisoresDe n minimo maximo | minimo >= maximo = True
| rem n minimo == 0 = False
| otherwise = noHayNumerosDivisoresDe n (minimo + 1) maximo
hermanada3 :: [Int] -> Bool
hermanada3 [b] = True
hermanada3 (a:b:xs) = (if ((a/=1) && (b/=1)) then ((gcd a b /= 1) && (primo2 (gcd a b))) else True)
&& hermanada3 (b:xs)
hermanada4 xs = undefined
---------------------------------------------------------------------------------------
--Adriana Gordillo, Elsa Domínguez
hermanadaC :: [Int] -> Bool
hermanadaC xs | elem 0 xs = False
| otherwise = and [(gcd x y == x) || (gcd x y == y) || not (null (primeFactors (gcd x y))) | (x,y) <- zip xs (tail xs)]
hermanadaS :: [Int] -> Bool
hermanadaS xs | elem 0 xs = False
| otherwise = and (map f (zip xs (tail xs)))
where f (x,y) = (gcd x y == x) || (gcd x y == y) || not (null (primeFactors (gcd x y)))
hermanadaR :: [Int] -> Bool
hermanadaR [x] = True
hermanadaR (x:y:xs) | elem 0 (x:y:xs) = False
| otherwise = ((gcd x y == x) || (gcd x y == y) || not (null (primeFactors (gcd x y)))) && hermanadaR (y:xs)
hermanadaPR :: [Int] -> Bool
hermanadaPR xs | elem 0 xs = False
| otherwise = foldr f True (zip xs (tail xs))
where f (x,y) recu = ((gcd x y == x) || (gcd x y == y) || not (null (primeFactors (gcd x y)))) && recu
-- ----------------------------------------------------------------------------
-- 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 (map, filter, ...)
-- 3) por recursión,
-- 4) por plegado (con 'foldr').
-- ---------------------------------------------------------------------------
-- Nota: Usa la función 'tails' de Data.List.
-- ----------------------------------------------------------------------------
--José Manuel García
permanentes1 :: [Int] -> [Int]
permanentes1 xs = [a | (a,b) <- (zip xs (init (tails xs))), a == maximum b ]
permanentes2 :: [Int] -> [Int]
permanentes2 xs = map head (filter p2 (init (tails xs)))
where p2 (x:xs) = x == maximum (x:xs)
comparacion3 :: Ord a => [a] -> [a] -> Bool
comparacion3 a [] = True
comparacion3 a b = a >= b
permanentes3 :: [Int] -> [Int]
permanentes3 [] = []
permanentes3 (x:xs) | [x] `comparacion3` [maximum3 xs] = x : permanentes3 xs
| otherwise = permanentes3 xs
where maximum3 [] = if x < 0 then x else -x
maximum3 xs = maximum xs
permanentes4:: [Int] -> [Int]
permanentes4 (x:xs) = foldr f4 [] (x:xs)
where f4 prim recu | [prim] `comparacion3` [maximum3 recu] = prim : recu
| otherwise = recu
maximum3 [] = if x < 0 then x else -x
maximum3 xs = maximum xs
-- Elsa Domínguez
permanentesC :: [Int] -> [Int]
permanentesC xs = [x | (x, xs') <- zip xs (tails (drop 1 xs)), xs' == [] || x >= maximum xs']
permanentesS :: [Int] -> [Int]
permanentesS xs = map fst (filter p (zip xs (tails xs)))
where p (x,i) = x == maximum i
permanentesR :: [Int] -> [Int]
permanentesR [] = []
permanentesR [x] = [x]
permanentesR (x:xs) | x >= maximum xs = [x] ++ permanentesR xs
| otherwise = permanentesR xs
permanentesPR :: [Int] -> [Int]
permanentesPR xs = foldr f [] (zip xs (tails xs))
where f (x,i) recu | x == maximum i = [x] ++ recu
| otherwise = recu
-- Adolfo Sagrera
permanentes xs = [ head xs | xs <- (init (tails xs)), head xs == maximum 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
-- --------------------------------------------------------------------
--José Manuel García
esPrimo :: Integral a => a -> Bool
esPrimo x = filter p2 [1..x] == [1,x]
where p2 b = (rem x b == 0)
muyPrimo :: Integer -> Bool
muyPrimo n | esPrimo n = length (show n) == sum [1 | a <- (descomposicion n), esPrimo (read a :: Integer) ]
| otherwise = False
where descomposicion n = [reverse x | x <- (init(tails (reverse (show n))))]
-- Elsa Domínguez
muyPrimo' :: Integer -> Bool
muyPrimo' n = and (map isPrime (lista n))
lista n = [read a :: Integer | a <- tail (inits (show n))]
-- ---------------------------------------------------------------------
-- ¿Cuántos números de cinco cifras son muy primos?
-- ---------------------------------------------------------------------
-- El cálculo es
--José Manuel García
calculoMuyPrimo = sum [1 | x <- [10000..99999], muyPrimo x] -- Tras unos minutos, sale 15.
-- Elsa Domínguez
muyPrimos5cifras = sum [1 | x <- [10000..99999], muyPrimo' x] -- Sale 15
-- ---------------------------------------------------------------------
![Informática de 1º de Matemáticas [Curso 2021-22, Grupo 2]](/WIKIS/I1M2021G2/resources/assets/logoUS.png)