Ejercicios de Haskell (I): listas, patrones, map, filter...

Aquí unos ejercicios de Haskell un poco más complicados que los de la entrada anterior sobre este lenguaje (aquí). En ellos practicamos sobre las características principales de la programación funcional, especialmente de Haskell: manejo de listas, patrones, funciones de orden superior: map y filter, pruebas con QuickCheck, tipos algebraicos y clases... Además adelanto que habrá una segunda parte dentro de unos días con más ejercicios.
Consideremos la declaración

        data Direction = North | South | East | West deriving (Eq,Ord,Enum,Show)

a) Utilizando la función fromEnum, define directamente una versión alternativa de la relación de orden (<), y llámala (<<)

(<<) :: Direction -> Direction -> Bool

Prueba que las dos relaciones de orden son iguales a través de QuickCheck, y la propiedad:

p_menor x y = (x < y) == (x << y)

instance Arbitrary Direction where

  arbitrary = do

                       n <- choose (0,3)

                       return $ toEnum n

b) Elimina la clase Ord en la cláusula deriving de la declaración data Direction , y trata de definir una instancia de Ord “manualmente” definiendo el operador (<=) a través de la relación anterior (<<).

--data Direction = North | South | East | West deriving (Eq,Ord,Enum,Show) -- Para a
data Direction = North | South | East | West deriving (Eq,Enum,Show) -- Para b


(<<) :: Direction -> Direction -> Bool
(<<) a b 
  | fromEnum a < fromEnum b       = True        
  | otherwise                     = False

instance Ord Direction where
  (<=) a b
    | a << b    = True  
    | otherwise = False

Define una función reparte :: [a] -> ([a],[a]) para “repartir” los elementos de una lista en dos sublistas asignando los elementos en forma alternada y en el mismo orden que el original.

     
reparte :: [a] -> ([a],[a])
reparte [x] = ([x],[])
reparte (x:y:zs) = (x:l1,y:l2)
  where 
    (l1, l2) = reparte zs

Usando  una lista por comprensión y la función divideA de un ejercicio anterior, define una función divisores que devuelva la lista de divisores naturales de un número natural.
Haz las modificaciones necesarias para obtener una nueva función divisores’ que devuelva los divisores (positivos y negativos) de un número entero:

     
divideA :: Integer -> Integer -> Bool
divideA a b 
  | a/= 0       = (mod b a == 0)
  | otherwise   = error "division por 0"
divisores :: Integer -> [Integer]
divisores a = [x | x<- [1..a], divideA x a]

divisores' :: Integer -> [Integer]
divisores' a = [x | x<- [(a)..(-a)],  divideA x a]

Un número natural p es primo si tiene exactamente dos divisores positivos distintos: 1 y p; por tanto, 1 no es un número primo.
a) Define una función esPrimo para comprobar si un número es primo.
b) Usando una lista por comprensión, define una función primosHasta que devuelva una lista con todos los números primos menores o iguales a un valor dado.
c) Da otra definición (con nombre primosHasta') que use la función predefinida filter en vez de la lista por comprensión.
d) Comprueba que las dos funciones que has definido se comportan del mismo modo comprobando con QuickCheck la siguiente propiedad:

p1_primos x = primosHasta x == primosHasta' x

     
esPrimo :: Integer -> Bool
esPrimo x =length (divisores x) == 2    
  
primosHasta :: Integer -> [Integer]
primosHasta n = [x | x <- [1..n], esPrimo x]

primosHasta' :: Integer -> [Integer]
primosHasta' n = filter esPrimo [1..n]

p1_primos x = primosHasta x == primosHasta' x

La conjetura de Goldbach fue formulada por Christian Goldbach en 1742 en una célebre carta a Euler. Es uno de los problemas abiertos (no resuelto) más antiguo de las Matemáticas y dice:
Todo número par mayor que 2 puede escribirse como la suma de dos primos.
Los dos primos no tienen que ser distintos. La conjetura ha sido comprobada con programas de ordenador para todos los pares menores a 1018, pero no ha podido ser demostrada. El objetivo de este ejercicio es comprobarla con Haskell.
a) Usando una lista por comprensión y las funciones del ejercicio anterior, define una función pares que tome como parámetro un entero n y devuelva una lista de tuplas con todos los pares de primos que suman n.(observa que los pares no aparecen duplicados).
b) Define una función goldbach que tome como parámetro un entero n y devuelva True si, siendo n par mayor que 2, existe al menos una pareja de primos que sume n.
Para resolver este apartado puedes utilizar el operador implicación lógica (=>>) , así como la función predefinida null :: [a] -> Bool, que toma una lista y devuelve True si es vacía.
c) Para comprobar la conjetura, define una función goldbachHasta que tome como parámetro
un entero n y que devuelva True si para todos los números pares mayores que 2 y menores o iguales a n se cumple la conjetura.
Ayuda: usa listas por comprensión y la función predefinida and :: [Bool] -> Bool que toma una lista de booleanos y devuelve True si todos son ciertos.

  pares:: Integer -> [(Integer, Integer)]
pares n = [(x,y) | x <- [1..n-2], y <- [x..n-2], esPrimo x, esPrimo y, x+y == n]

infixl 1 ==>>
(==>>) :: Bool -> Bool -> Bool

False ==>> y    =       True
True ==>>  y     =       y


goldbach :: Integer-> Bool
goldbach n 
  | n> 2 && even n ==>> not (null (pares n)) = True
  | otherwise = False

goldbachHasta :: Integer -> Bool
goldbachHasta n = and( [ goldbach x| x <- [2..n], even x])

Los factores propios de un número x son los divisores naturales de x estrictamente menores a x. Un número natural es perfecto si coincide con la suma de sus factores propios.
a) Escribe una función esPerfecto para comprobar si un número es perfecto.
b) Escribe otra función que devuelva una lista con los números perfectos menores o iguales a un valor dado.

esPerfecto :: Integer -> Bool
esPerfecto n  = sum([x| x <- take ((length (divisores n)) -1) (divisores n)]) == n

perfectosMenoresQue :: Integer -> [Integer]
perfectosMenoresQue n = [x| x <- [1..n], esPerfecto x]

La función predefinida take toma un número natural n y una lista xs, y devuelve una lista con los n primeros elementos de xs.
a) Dado que no es posible volver a definir una función predefinida, completa la siguiente definición

take' :: Int -> [a] -> [a]

take' n xs = [ ??? | (p,x) <- zip [0.. ??? ] xs ]

para que la función take' se comporte como la función predefinida take:

take' :: Int -> [a] -> [a]
take' n xs = [ x | (p,x) <- zip [0.. n-1] xs ]

drop' :: Int -> [a] -> [a]
drop' n xs = [ x | (p,x) <- zip [ 0.. length xs ] xs, p >= n ]

-- para cualquier n≥0 y cualquier lista xs, si concatenamos la lista take' n xs con la lista drop' n xs, obtenemos la lista original.

p_takedrop n xs = n >= 0 ==> (take' n xs) ++ (drop' n xs) == xs

La función predefinida concat :: [[a]] -> [a] toma una lista de listas y devuelve la lista que se obtiene al concatenar todos sus elementos: concat [ [1,2,3], [5,6], [8,0,1,2] ] -> [1,2,3,5,6,8,0,1,2]
a) Dado que no es posible volver a definir una función predefinida, define usando foldr una función concat' que se comporte como la predefinida.
Ayuda: observa que el resultado se puede calcular con la siguiente expresión:
[1,2,3] ++ ( [5,6] ++ ( [8,0,1,2] ++ [] ) )
donde el operador predefinido (++) concatena dos listas.
b) Da ahora una definición alternativa concat'' usando listas por comprensión. Usa para ello dos generadores; el primero extraerá cada lista de la lista de listas argumento; el segundo extraerá los elementos de las listas extraídas por el primer generador.

concat' :: [[a]] -> [a]
concat' xss = foldr (++) [] xss

concat'' :: [[a]] -> [a]
concat'' xss= [ y | x<- xss, y <- x]

La función predefinida
takeWhile :: (a -> Bool) -> [a] -> [a]
devuelve el prefijo más largo con los elementos de una lista (2º argumento) que cumplen una condición (1er argumento). Por ejemplo:

takeWhile even [2,4,6,8,11,13,16,20] ->[2,4,6,8]

ya que el 11 es el primer elemento que no es par. Otro ejemplo de uso es:

takeWhile (<5) [2,4,6,1] -> [2,4]

ya que 6 es el primer elemento de la lista mayor o igual a 5. Para los mismos argumentos, la función dropWhile suprime el prefijo que takeWhile devuelve. Por ejemplo:

dropWhile even [2,4,6,8,11,13,16,20] -> [11,13,16,20]

a) Usando estas funciones, define una función inserta que tome un elemento x y una lista xs que ya está ordenada ascendentemente (asume que esta precondición se cumple), y que devuelva la lista ordenada que se obtiene al insertar x en su posición adecuada dentro de xs.
b) Sin usar ninguna función auxiliar, define directamente y en forma recursiva la función inserta.
c) Lee, entiende y comprueba con QuickCheck la siguiente propiedad referente a la función inserta: p1_inserta x xs = desconocida xs ==> desconocida (inserta x xs)
d) Podemos utilizar la función inserta que hemos definido para ordenar ascendentemente una lista desordenada. Por ejemplo, si quisiéramos ordenar la lista [9,3,7], podríamos hacerlo evaluando la expresión: 9 `inserta` (3 `inserta` (7 `inserta` []))
Razona por qué funciona este algoritmo para ordenar una lista.
e) Usando la función foldr y la función inserta, define una función ordena que tome una lista de valores y la devuelva ordenada.
f) Escribe y comprueba con QuickCheck la siguiente propiedad: para cualquier lista xs, ordena xs es una lista ordenada.

inserta :: (Ord a) => a -> [a] -> [a]
inserta x xs = takeWhile (<x) xs ++ [x] ++dropWhile (<x) xs

inserta' :: (Ord a) => a -> [a] -> [a]
inserta' a [] = [a]
inserta' a (x:xs) 
  | a < x       = a : (x:xs)
  | otherwise   = x: (inserta' a xs)

p1_inserta x xs = desconocida xs ==> desconocida (inserta x xs)
p1_inserta' x xs = desconocida xs ==> desconocida (inserta' x xs)

ordena :: (Ord a) => [a] -> [a]
ordena xs = foldr (inserta) [] xs
-- para cualquier lista xs, ordena xs es una lista ordenada.
p1_ordena xs = desconocida(ordena xs)

La  función de orden superior predefinida
iterate :: (a -> a) -> a -> [a]
iterate f x = x : iterate f (f x)
toma como argumentos una función f y un valor x, y devuelve la lista infinita siguiente:
iterate f x-> [x, f x, f (f x), f (f (f x))), f (f (f (f x)))), ... ]
Es decir, el primer término es x y los demás se obtienen aplicando la función f al término que le precede. Usando iterate, es posible definir secuencias aritméticas si la función f suma cierta cantidad fija. Por ejemplo:
iterate (+1) 0  [ 0, 1, 2, 3, 4 ...
iterate (+2) 1  [ 1, 3, 5, 7, 9 ...
a) Una secuencia geométrica está constituida por una secuencia de elementos en la que cada uno de ellos se obtiene multiplicando el anterior por una constante denominada razón o factor de la secuencia. Define usando iterate una función geométrica que devuelva una lista con una secuencia geométrica, dados el valor inicial y la razón. Por ejemplo:
geométrica 1 2 -> [ 1, 2, 4, 8, 16 ...
geométrica 10 3 -> [ 10, 30, 90, 270,...
b) ¿Qué comprueba la siguiente propiedad?
p1_geométrica x r = x>0 && r>0 ==>
and [ div z y == r | (y,z) <- zip xs (tail xs) ]
where xs = take 100 (geométrica x r)
c) Usando iterate, define una función múltiplosDe que devuelva una lista con los múltiplos de su argumento. Por ejemplo:
múltiplosDe 2 -> [ 0, 2, 4, 6, 8, 10 ...
múltiplosDe 3 -> [ 0, 3, 6, 9, 12, 15 ...
d) Usando iterate, define una función potenciasDe que devuelva una lista con las potencias de su argumento. Por ejemplo:
potenciasDe 2 -> [ 1, 2, 4, 8, 16, 32 ...
potenciasDe 3 -> [ 1, 3, 9, 27, 81, ...

geométrica :: (Num a) => a -> a-> [a]
geométrica vi ra = iterate (*ra) vi

p1_geométrica x r = x>0 && r>0 ==> and [ div z y == r | (y,z) <- zip xs (tail xs) ]
  where xs = take 100 (geométrica x r)
-- Que todos los elementos son múltiplos de la razón

múltiplosDe :: Integer -> [Integer]
múltiplosDe n = iterate (+n) n

potenciasDe :: Integer -> [Integer]
potenciasDe n = iterate (*n) 1

Aunque la función predefinida lcm (least common multiple) ya lo hace, el objetivo de este ejercicio es escribir una función mcm para calcular el mínimo común múltiplo de dos naturales.
a) Define una función múltiplosDe, que tome como parámetro un número mayor que cero y devuelva una lista infinita con sus múltiplos positivos. Por ejemplo:
múltiplosDe 3 -> [3,6,9,12,15,...
Ayuda: usa la función predefinida iterate, descrita en un ejercicio anterior.
b) Define la función sobrecargada para tipos con orden
primeroComún :: Ord a => [a] -> [a] -> a
que tome dos listas ordenadas ascendentemente y devuelva el menor elemento común a ambas. Por ejemplo:
primeroComún [1,2,5,7,9] [3,3,4,5,7] -> 5
c) El mínimo común múltiplo de dos naturales x e y es el menor natural positivo múltiplo de ambos. Utilizando las funciones definidas en los apartados previos, escribe una función mcm que calcule el mínimo común múltiplo de dos naturales usando esta definición.
d) Comprueba usando QuickCheck tu definición mediante esta propiedad:
p_mcm x y = x>=0 && y>=0 ==> mcm x y == lcm x y

primeroComún :: Ord a => [a] -> [a] -> a
primeroComún              (x:xs) (y:ys) 
  | x > y  = primeroComún (x:xs)    ys  
  | x < y  = primeroComún xs    (y:ys)
  | otherwise = x

mcm' :: Integer -> Integer-> Integer
mcm' 0 _ = 0
mcm' _ 0 = 0
mcm' x y = primeroComún (múltiplosDe x) (múltiplosDe y)

p_mcm x y = x>=0 && y>=0 ==> mcm' x y == lcm x y

Define la función sobrecargada para tipos con orden

primeroComúnDeTres :: Ord a => [a] -> [a] -> [a] -> a

que tome tres listas ordenadas ascendentemente y devuelva el menor elemento común a ambas.

primeroComúnDeTres :: Ord a => [a] -> [a] -> [a] -> a
primeroComúnDeTres (x:xs) (y:ys) (z:zs)
  | x > y = primeroComúnDeTres (x:xs) ys (z:zs)
  | x > z = primeroComúnDeTres (x:xs) (y:ys) zs
  | y > x = primeroComúnDeTres xs (y:ys) (z:zs)
  | y > z = primeroComúnDeTres (x:xs) (y:ys) zs
  | z > x = primeroComúnDeTres xs (y:ys) (z:zs)
  | z > y =primeroComúnDeTres (x:xs) ys (z:zs)
  | otherwise = x