Edición de «Relación 9»

<source lang='haskell'>

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

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

-- 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 xs)
            where f x = x*10^(length (dropWhile (/=x) xs) -1)

dec2entR :: [Integer] -> Integer
dec2entR [] = 0
dec2entR (x:xs) = x*10^(length xs) + dec2entR xs

dec2entPR :: [Integer] -> Integer
dec2entPR xs = foldr f 0 xs
             where f x recu = x*10^(length (dropWhile (/=x) xs) -1) + recu

-- ----------------------------------------------------------------------------
-- 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
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
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
hermanadaC1 xs  | elem 0 xs = False
                | otherwise = and[(gcd x y == x) || (gcd x y==y) || isPrime (head (primeFactors (gcd x y))) |(x,y)<- zip xs ys]
       where ys = tail xs
  
hermanadaS1 xs | elem 0 xs = False
               |otherwise = and(map f zs)
  where ys= tail xs
        zs = zip xs ys
        f (x,y) = (gcd x y == x) || (gcd x y==y)||isPrime (head (primeFactors (gcd x y)))

hermanadaR1 [x]= True
hermanadaR1 (x:y:xs) | elem 0 (x:y:xs) = False
                     | (gcd x y == x) || (gcd x y==y) || isPrime (head (primeFactors (gcd x y))) = True && hermanadaR1 (y:xs)
                     |otherwise = False         


hermanadaP1 xs  | elem 0 xs = False
                | otherwise = foldr f True zs
  where ys= tail xs
        zs = zip xs ys
        f (x,y) recu = (gcd x y == x) || (gcd x y==y) || isPrime (head (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 = filter p xs
                where p x = x == maximum (dropWhile (/=x) xs)
  
permanentesR :: [Int] -> [Int]
permanentesR [] = []
permanentesR [x] = [x] 
permanentesR (x:xs) | x >= maximum xs  = [x] ++ permanentesR xs
                    | otherwise        = permanentesR xs
                    
permanentesPR :: [Int] -> [Int]
permanentesPR (x:xs) = foldr f [] (x:xs)
                     where f x recu | x >= maximum' (dropWhile (/=x) xs)  = [x] ++ recu
                                    | otherwise                           = recu
maximum' xs | null xs    = 0
            | otherwise  = 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 

-- ---------------------------------------------------------------------




</source>