Acciones

Relación 6 Sol

De Informática de 1º de Matemáticas [Curso 2021-22, Grupo 3]

Revisión del 18:55 28 dic 2021 de Jpro (discusión | contribs.) (Página creada con «<source lang='haskell'> -- I1M 2021-22: -- Funciones de orden superior y definiciones por plegados (II) -- Departamento de Ciencias de la Computación e Inteligencia Artif…»)
(difs.) ← Revisión anterior | Revisión actual (difs.) | Revisión siguiente → (difs.)
-- 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)

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