Recursión – Página 16

Mínimos locales

PorJosé A. Alonso 19-noviembre-201427-diciembre-2014

Enunciado

-- Un mínimo local de una lista es un elemento de la lista que es menor
-- que su predecesor y que su sucesor en la lista. Por ejemplo, 1 es un
-- mínimo local de [3,2,1,3,7,7,1,0,2] ya que es menor  que 2 (su
-- predecesor) y que 3 (su sucesor). 
-- 
-- Definir la función
--    minimosLocales :: Ord a => [a] -> [a]
-- tal que (minimosLocales xs) es la lista de los mínimos locales de la
-- lista xs. Por ejemplo,
--    minimosLocales [3,2,1,3,7,7,9,6,8]  ==  [1,6]
--    minimosLocales [1..100]             ==  []
--    minimosLocales "mqexvzat"           ==  "eva"

-- Un mínimo local de una lista es un elemento de la lista que es menor

-- que su predecesor y que su sucesor en la lista. Por ejemplo, 1 es un

-- mínimo local de [3,2,1,3,7,7,1,0,2] ya que es menor que 2 (su

-- predecesor) y que 3 (su sucesor).

-- Definir la función

-- minimosLocales :: Ord a => [a] -> [a]

-- tal que (minimosLocales xs) es la lista de los mínimos locales de la

-- lista xs. Por ejemplo,

-- minimosLocales [3,2,1,3,7,7,9,6,8] == [1,6]

-- minimosLocales [1..100] == []

-- minimosLocales "mqexvzat" == "eva"

Soluciones

[schedule expon=’2014-11-26′ expat=»06:00″]

Las soluciones se pueden escribir en los comentarios hasta el 26 de noviembre.
El código se debe escribir entre una línea con <pre lang=»haskell»> y otra con </pre>

[/schedule]

[schedule on=’2014-11-26′ at=»06:00″]

-- 1ª definición (por recursión):
minimosLocales1 :: Ord a => [a] -> [a]
minimosLocales1 (x:y:z:xs) | y < x && y < z = y : minimosLocales1 (z:xs)
                           | otherwise      = minimosLocales1 (y:z:xs)
minimosLocales1 _                           = []

-- 2ª definición (por comprensión):
minimosLocales2 :: Ord a => [a] -> [a]
minimosLocales2 xs = 
    [y | (x,y,z) <- zip3 xs (tail xs) (drop 2 xs), y < x, y < z]

-- 1ª definición (por recursión):

minimosLocales1 :: Ord a => [a] -> [a]

minimosLocales1 (x:y:z:xs) | y < x && y < z = y : minimosLocales1 (z:xs)

| otherwise = minimosLocales1 (y:z:xs)

minimosLocales1 _ = []

-- 2ª definición (por comprensión):

minimosLocales2 :: Ord a => [a] -> [a]

minimosLocales2 xs =

[y | (x,y,z) <- zip3 xs (tail xs) (drop 2 xs), y < x, y < z]

[/schedule]

Último dígito no nulo del factorial

PorJosé A. Alonso 14-noviembre-201425-abril-2021

Enunciado

-- El factorial de 7 es
--    7! = 1 * 2 * 3 * 4 * 5 * 6 * 7 = 5040
-- por tanto, el último dígito no nulo del factorial de 7 es 4.
-- 
-- Definir la función
--    ultimoNoNuloFactorial :: Integer -> Integer
-- tal que (ultimoNoNuloFactorial n) es el último dígito no nulo del
-- factorial de n. Por ejemplo,
--    ultimoNoNuloFactorial  7  == 4
--    ultimoNoNuloFactorial 10  == 8
--    ultimoNoNuloFactorial 12  == 6
--    ultimoNoNuloFactorial 97  == 2
--    ultimoNoNuloFactorial  0  == 1
--
-- Comprobar con QuickCheck que si n es mayor que 4, entonces el último
-- dígito no nulo del factorial de n es par.

-- El factorial de 7 es

-- 7! = 1 * 2 * 3 * 4 * 5 * 6 * 7 = 5040

-- por tanto, el último dígito no nulo del factorial de 7 es 4.

-- Definir la función

-- ultimoNoNuloFactorial :: Integer -> Integer

-- tal que (ultimoNoNuloFactorial n) es el último dígito no nulo del

-- factorial de n. Por ejemplo,

-- ultimoNoNuloFactorial 7 == 4

-- ultimoNoNuloFactorial 10 == 8

-- ultimoNoNuloFactorial 12 == 6

-- ultimoNoNuloFactorial 97 == 2

-- ultimoNoNuloFactorial 0 == 1

-- Comprobar con QuickCheck que si n es mayor que 4, entonces el último

-- dígito no nulo del factorial de n es par.

Soluciones

import Test.QuickCheck

ultimoNoNuloFactorial :: Integer -> Integer
ultimoNoNuloFactorial n = ultimoNoNulo (factorial n)

-- (ultimoNoNulo n) es el último dígito no nulo de n. Por ejemplo,
--    ultimoNoNulo 5040  ==  4
ultimoNoNulo :: Integer -> Integer
ultimoNoNulo n | m /= 0    = m
               | otherwise = ultimoNoNulo (n `div` 10)
               where m = n `rem` 10

-- 2ª definición (por comprensión)
ultimoNoNulo2 :: Integer -> Integer
ultimoNoNulo2 n = read [head (dropWhile (=='0') (reverse (show n)))]

-- (factorial n) es el factorial de n. Por ejemplo,
--    factorial 7  ==  5040
factorial :: Integer -> Integer
factorial n = product [1..n]


-- La propiedad es
prop_ultimoNoNuloFactorial :: Integer -> Property
prop_ultimoNoNuloFactorial n = 
    n > 4 ==> even (ultimoNoNuloFactorial n)
                  
-- La comprobación es
--    ghci> quickCheck prop_ultimoNoNuloFactorial
--    +++ OK, passed 100 tests.

import Test.QuickCheck

ultimoNoNuloFactorial :: Integer -> Integer

ultimoNoNuloFactorial n = ultimoNoNulo (factorial n)

-- (ultimoNoNulo n) es el último dígito no nulo de n. Por ejemplo,

-- ultimoNoNulo 5040 == 4

ultimoNoNulo :: Integer -> Integer

ultimoNoNulo n | m /= 0 = m

| otherwise = ultimoNoNulo (n `div` 10)

where m = n `rem` 10

-- 2ª definición (por comprensión)

ultimoNoNulo2 :: Integer -> Integer

ultimoNoNulo2 n = read [head (dropWhile (=='0') (reverse (show n)))]

-- (factorial n) es el factorial de n. Por ejemplo,

-- factorial 7 == 5040

factorial :: Integer -> Integer

factorial n = product [1..n]

-- La propiedad es

prop_ultimoNoNuloFactorial :: Integer -> Property

prop_ultimoNoNuloFactorial n =

n > 4 ==> even (ultimoNoNuloFactorial n)

-- La comprobación es

-- ghci> quickCheck prop_ultimoNoNuloFactorial

-- +++ OK, passed 100 tests.

Precio total

PorJosé A. Alonso 11-noviembre-20141-mayo-2016

Enunciado

-- Una función de precio determina el precio de cada elemento; por
-- ejemplo,
--    precioCI :: String -> Int
--    precioCI "leche"       = 10
--    precioCI "mantequilla" = 18
--    precioCI "patatas"     = 22
--    precioCI "chocolate"   = 16
-- 
-- Definir la función
--    precioTotal :: (String -> Int) -> [String] -> Int
-- tal que (precioTotal f xs) es el precio total de los elementos de xs
-- respecto de la función de precio f. Por ejemplo,
--    precioTotal precioCI ["leche", "leche", "mantequilla"]  ==  38
--    precioTotal precioCI ["chocolate", "mantequilla"]       ==  34

-- Una función de precio determina el precio de cada elemento; por

-- ejemplo,

-- precioCI :: String -> Int

-- precioCI "leche" = 10

-- precioCI "mantequilla" = 18

-- precioCI "patatas" = 22

-- precioCI "chocolate" = 16

-- Definir la función

-- precioTotal :: (String -> Int) -> [String] -> Int

-- tal que (precioTotal f xs) es el precio total de los elementos de xs

-- respecto de la función de precio f. Por ejemplo,

-- precioTotal precioCI ["leche", "leche", "mantequilla"] == 38

-- precioTotal precioCI ["chocolate", "mantequilla"] == 34

Soluciones

-- 1ª solución (por comprensión):
precioTotal1 :: (String -> Int) -> [String] -> Int
precioTotal1 f xs = sum [precioCI x | x <- xs]

-- 2ª solución (por recursión):
precioTotal2 :: (String -> Int) -> [String] -> Int
precioTotal2 f []     = 0
precioTotal2 f (x:xs) = f x + precioTotal2 f xs

-- 3ª solución (por plegado)
precioTotal3 :: (String -> Int) -> [String] -> Int
precioTotal3 f = foldr g 0
    where g x y = f x + y

-- 4ª solución (por plegado y lambda)
precioTotal4 :: (String -> Int) -> [String] -> Int
precioTotal4 f = foldr (\x y -> f x + y) 0

-- 5ª solución (por plegado y composición)
precioTotal5 :: (String -> Int) -> [String] -> Int
precioTotal5 f = foldr ((+) . f) 0

-- 1ª solución (por comprensión):

precioTotal1 :: (String -> Int) -> [String] -> Int

precioTotal1 f xs = sum [precioCI x | x <- xs]

-- 2ª solución (por recursión):

precioTotal2 :: (String -> Int) -> [String] -> Int

precioTotal2 f [] = 0

precioTotal2 f (x:xs) = f x + precioTotal2 f xs

-- 3ª solución (por plegado)

precioTotal3 :: (String -> Int) -> [String] -> Int

precioTotal3 f = foldr g 0

where g x y = f x + y

-- 4ª solución (por plegado y lambda)

precioTotal4 :: (String -> Int) -> [String] -> Int

precioTotal4 f = foldr (\x y -> f x + y) 0

-- 5ª solución (por plegado y composición)

precioTotal5 :: (String -> Int) -> [String] -> Int

precioTotal5 f = foldr ((+) . f) 0

Extensión de un fichero

PorJosé A. Alonso 10-noviembre-20141-mayo-2016

Enunciado

-- La extensión de un fichero es la palabra a continuación del último
-- punto en el nombre del fichero. Por ejemplo, la extensión de
-- "documento.txt" es "txt" 
-- 
-- Definir la función
--    extension :: String -> String
-- tal que (extension cs) es la extensión del fichero cs. Por ejemplo,
--    extension "ejercicio.hs"       ==  "hs"
--    extension "documento.txt"      ==  "txt"
--    extension "documento.txt.pdf"  ==  "pdf"
--    extension "resumen"            ==  ""

-- La extensión de un fichero es la palabra a continuación del último

-- punto en el nombre del fichero. Por ejemplo, la extensión de

-- "documento.txt" es "txt"

-- Definir la función

-- extension :: String -> String

-- tal que (extension cs) es la extensión del fichero cs. Por ejemplo,

-- extension "ejercicio.hs" == "hs"

-- extension "documento.txt" == "txt"

-- extension "documento.txt.pdf" == "pdf"

-- extension "resumen" == ""

Soluciones

-- 1ª definición (por recursión):
extension1 :: String -> String
extension1 cs | elem '.' cs = reverse (aux (reverse cs))
              | otherwise   = ""
    where aux []       = []
          aux ('.':cs) = []
          aux (c:cs)   = c : aux cs

-- 2ª definición (con takeWhile):
extension2 :: String -> String
extension2 cs
    | notElem '.' cs = ""
    | otherwise      = reverse (takeWhile (/= '.') (reverse cs))

-- 1ª definición (por recursión):

extension1 :: String -> String

extension1 cs | elem '.' cs = reverse (aux (reverse cs))

| otherwise = ""

where aux [] = []

aux ('.':cs) = []

aux (c:cs) = c : aux cs

-- 2ª definición (con takeWhile):

extension2 :: String -> String

extension2 cs

| notElem '.' cs = ""

| otherwise = reverse (takeWhile (/= '.') (reverse cs))

Distancia de Hamming

PorJosé A. Alonso 7-noviembre-201425-abril-2021

Enunciado

-- La distancia de Hamming entre dos listas es el número de posiciones
-- en que los correspondientes elementos son distintos. Por ejemplo, la
-- distancia de Hamming entre "roma" y "loba" es 2 (porque hay 2
-- posiciones en las que los elementos correspondientes son distintos:
-- la 1ª y la 3ª). 
-- 
-- Definir la función
--    distancia :: Eq a => [a] -> [a] -> Int
-- tal que (distancia xs ys) es la distancia de Hamming entre xs e
-- ys. Por ejemplo,
--    distancia "romano" "comino"  ==  2
--    distancia "romano" "camino"  ==  3
--    distancia "roma"   "comino"  ==  2
--    distancia "roma"   "camino"  ==  3
--    distancia "romano" "ron"     ==  1
--    distancia "romano" "cama"    ==  2
--    distancia "romano" "rama"    ==  1
--
-- Comprobar con QuickCheck si la distancia de Hamming tiene la
-- siguiente propiedad
--    distancia(xs,ys) = 0 si, y sólo si, xs = ys
-- y, en el caso de que no se verifique, modificar ligeramente la
-- propiedad para obtener una condición necesaria y suficiente de 
-- distancia(xs,ys) = 0.

-- La distancia de Hamming entre dos listas es el número de posiciones

-- en que los correspondientes elementos son distintos. Por ejemplo, la

-- distancia de Hamming entre "roma" y "loba" es 2 (porque hay 2

-- posiciones en las que los elementos correspondientes son distintos:

-- la 1ª y la 3ª).

-- Definir la función

-- distancia :: Eq a => [a] -> [a] -> Int

-- tal que (distancia xs ys) es la distancia de Hamming entre xs e

-- ys. Por ejemplo,

-- distancia "romano" "comino" == 2

-- distancia "romano" "camino" == 3

-- distancia "roma" "comino" == 2

-- distancia "roma" "camino" == 3

-- distancia "romano" "ron" == 1

-- distancia "romano" "cama" == 2

-- distancia "romano" "rama" == 1

-- Comprobar con QuickCheck si la distancia de Hamming tiene la

-- siguiente propiedad

-- distancia(xs,ys) = 0 si, y sólo si, xs = ys

-- y, en el caso de que no se verifique, modificar ligeramente la

-- propiedad para obtener una condición necesaria y suficiente de

-- distancia(xs,ys) = 0.

Soluciones

import Test.QuickCheck

-- 1ª definición (por comprensión):
distancia :: Eq a => [a] -> [a] -> Int
distancia xs ys = sum [1 | (x,y) <- zip xs ys, x /= y] 

-- 2ª definición (por recursión):
distancia2 :: Eq a => [a] -> [a] -> Int
distancia2 [] ys = 0
distancia2 xs [] = 0
distancia2 (x:xs) (y:ys) | x /= y    = 1 + distancia2 xs ys
                         | otherwise = distancia2 xs ys

-- La propiedad es
prop_distancia1 :: [Int] -> [Int] -> Bool
prop_distancia1 xs ys =
    (distancia xs ys == 0) == (xs == ys)

-- La comprobación es
--    ghci> quickCheck prop_distancia1
--    *** Failed! Falsifiable (after 2 tests and 1 shrink): 
--    []
--    [1]
-- En efecto,
--    ghci> distancia [] [1] == 0
--    True
--    ghci> [] == [1]
--    False

-- La primera modificación es restringir la propiedad a lista de igual
-- longitud: 
prop_distancia2 :: [Int] -> [Int] -> Property
prop_distancia2 xs ys =
    length xs == length ys ==> 
    (distancia xs ys == 0) == (xs == ys)

-- La comprobación es
--    ghci> quickCheck prop_distancia2
--    *** Gave up! Passed only 33 tests.

-- Nota. La propiedad se verifica, pero al ser la condición demasiado
-- restringida sólo 33 de los casos la cumple.

-- La segunda restricción es limitar las listas a la longitud de la más
-- corta: 
prop_distancia3 :: [Int] -> [Int] -> Bool
prop_distancia3 xs ys =
    (distancia xs ys == 0) == (take n xs == take n ys)
    where n = min (length xs) (length ys)

-- La comprobación es
--    ghci> quickCheck prop_distancia3
--    +++ OK, passed 100 tests.

import Test.QuickCheck

-- 1ª definición (por comprensión):

distancia :: Eq a => [a] -> [a] -> Int

distancia xs ys = sum [1 | (x,y) <- zip xs ys, x /= y]

-- 2ª definición (por recursión):

distancia2 :: Eq a => [a] -> [a] -> Int

distancia2 [] ys = 0

distancia2 xs [] = 0

distancia2 (x:xs) (y:ys) | x /= y = 1 + distancia2 xs ys

| otherwise = distancia2 xs ys

-- La propiedad es

prop_distancia1 :: [Int] -> [Int] -> Bool

prop_distancia1 xs ys =

(distancia xs ys == 0) == (xs == ys)

-- La comprobación es

-- ghci> quickCheck prop_distancia1

-- *** Failed! Falsifiable (after 2 tests and 1 shrink):

-- []

-- [1]

-- En efecto,

-- ghci> distancia [] [1] == 0

-- True

-- ghci> [] == [1]

-- False

-- La primera modificación es restringir la propiedad a lista de igual

-- longitud:

prop_distancia2 :: [Int] -> [Int] -> Property

prop_distancia2 xs ys =

length xs == length ys ==>

(distancia xs ys == 0) == (xs == ys)

-- La comprobación es

-- ghci> quickCheck prop_distancia2

-- *** Gave up! Passed only 33 tests.

-- Nota. La propiedad se verifica, pero al ser la condición demasiado

-- restringida sólo 33 de los casos la cumple.

-- La segunda restricción es limitar las listas a la longitud de la más

-- corta:

prop_distancia3 :: [Int] -> [Int] -> Bool

prop_distancia3 xs ys =

(distancia xs ys == 0) == (take n xs == take n ys)

where n = min (length xs) (length ys)

-- La comprobación es

-- ghci> quickCheck prop_distancia3

-- +++ OK, passed 100 tests.

Suma de todos los anteriores.

PorJosé A. Alonso 5-noviembre-201427-diciembre-2014

Enunciado

-- Definir la función
--    sumaAnteriores :: [Integer] -> Bool
-- tal que (sumaAnteriores xs) se verifica si cada elemento de la lista
-- xs (excepto el primero) es la suma de sus anteriores elementos en la
-- lista. Por ejemplo,  
--    sumaAnteriores [3,3,6,12]  ==  True
--    sumaAnteriores [3,3,7,10]  ==  False
--    sumaAnteriores [3]         ==  True
--    sumaAnteriores []          ==  True

-- Definir la función

-- sumaAnteriores :: [Integer] -> Bool

-- tal que (sumaAnteriores xs) se verifica si cada elemento de la lista

-- xs (excepto el primero) es la suma de sus anteriores elementos en la

-- lista. Por ejemplo,

-- sumaAnteriores [3,3,6,12] == True

-- sumaAnteriores [3,3,7,10] == False

-- sumaAnteriores [3] == True

-- sumaAnteriores [] == True

Soluciones

import Test.QuickCheck

-- 1ª definición (por recursión):
sumaAnteriores :: [Integer] -> Bool
sumaAnteriores xs = aux (reverse xs)
    where aux []     = True
          aux [_]    = True
          aux (x:xs) = x == sum xs && aux xs

-- 2ª definición (por comprensión):
sumaAnteriores2 :: [Integer] -> Bool
sumaAnteriores2 (x:y:zs) = 
    x == y && and [b == 2*a | (a,b) <- adyacentes (y:zs)]
    where adyacentes xs = zip xs (tail xs)
sumaAnteriores2 _ = True

-- La propiedad de equivalencia es
prop_equiv_sumaAnteriores :: [Integer] -> Bool
prop_equiv_sumaAnteriores xs = 
    sumaAnteriores xs == sumaAnteriores2 xs

import Test.QuickCheck

-- 1ª definición (por recursión):

sumaAnteriores :: [Integer] -> Bool

sumaAnteriores xs = aux (reverse xs)

where aux [] = True

aux [_] = True

aux (x:xs) = x == sum xs && aux xs

-- 2ª definición (por comprensión):

sumaAnteriores2 :: [Integer] -> Bool

sumaAnteriores2 (x:y:zs) =

x == y && and [b == 2*a | (a,b) <- adyacentes (y:zs)]

where adyacentes xs = zip xs (tail xs)

sumaAnteriores2 _ = True

-- La propiedad de equivalencia es

prop_equiv_sumaAnteriores :: [Integer] -> Bool

prop_equiv_sumaAnteriores xs =

sumaAnteriores xs == sumaAnteriores2 xs

Máximo de una función

PorJosé A. Alonso 4-noviembre-201427-diciembre-2014

Enunciado

-- Se considera la siguiente función
--    g :: Integer -> Integer
--    g n = if n < 10 then n*n else n
-- 
-- Definir la función 
--    max_g :: Integer -> Integer
-- tal que (max_g n) es el punto i del intervalo [0,n] donde g alcanza
-- el máximo de sus valores, si n es positivo y 0 en caso contrario. Por
-- ejemplo,
--    max_g (-7)  ==  0
--    max_g 7     ==  7
--    max_g 14    ==  9
--    max_g 84    ==  84
-- 
-- Comprobar con QuickCheck que la función max_g es equivalente a la
-- función f definida por  
--    f :: Integer -> Integer
--    f n | n < 0             = 0
--        | n >= 10 && n < 81 = 9
--        | otherwise         = n
--
-- Nota: Se piden dos definiciones de max_g, una por comprensión y otra
-- por recursión.

-- Se considera la siguiente función

-- g :: Integer -> Integer

-- g n = if n < 10 then n*n else n

-- Definir la función

-- max_g :: Integer -> Integer

-- tal que (max_g n) es el punto i del intervalo [0,n] donde g alcanza

-- el máximo de sus valores, si n es positivo y 0 en caso contrario. Por

-- ejemplo,

-- max_g (-7) == 0

-- max_g 7 == 7

-- max_g 14 == 9

-- max_g 84 == 84

-- Comprobar con QuickCheck que la función max_g es equivalente a la

-- función f definida por

-- f :: Integer -> Integer

-- f n | n < 0 = 0

-- | n >= 10 && n < 81 = 9

-- | otherwise = n

-- Nota: Se piden dos definiciones de max_g, una por comprensión y otra

-- por recursión.

Soluciones

import Test.QuickCheck

g :: Integer -> Integer
g n = if n < 10 then n*n else n

-- 1ª definición (por comprensión):
max_gC :: Integer -> Integer
max_gC n | n < 0     = 0 
         | otherwise = snd (maximum [(g i,i) | i <- [0..n]])

-- 2ª definición (por recursión):
max_gR :: Integer -> Integer
max_gR n | n < 0      = 0
         | g m > g n  = m 
         | otherwise  = n
         where m = max_gR (n - 1)

f :: Integer -> Integer
f n | n < 0             = 0
    | n >= 10 && n < 81 = 9
    | otherwise         = n

-- La propiedad con max_gR es
prop_max_gR n = max_gR n == f n

-- La comprobación es
--    ghci> quickCheck prop_max_gR
--    +++ OK, passed 100 tests.

-- La propiedad con max_gC es
prop_max_gC n = max_gC n == f n

-- La comprobación es
--    ghci> quickCheck prop_max_gC
--    +++ OK, passed 100 tests.

import Test.QuickCheck

g :: Integer -> Integer

g n = if n < 10 then n*n else n

-- 1ª definición (por comprensión):

max_gC :: Integer -> Integer

max_gC n | n < 0 = 0

| otherwise = snd (maximum [(g i,i) | i <- [0..n]])

-- 2ª definición (por recursión):

max_gR :: Integer -> Integer

max_gR n | n < 0 = 0

| g m > g n = m

| otherwise = n

where m = max_gR (n - 1)

f :: Integer -> Integer

f n | n < 0 = 0

| n >= 10 && n < 81 = 9

| otherwise = n

-- La propiedad con max_gR es

prop_max_gR n = max_gR n == f n

-- La comprobación es

-- ghci> quickCheck prop_max_gR

-- +++ OK, passed 100 tests.

-- La propiedad con max_gC es

prop_max_gC n = max_gC n == f n

-- La comprobación es

-- ghci> quickCheck prop_max_gC

-- +++ OK, passed 100 tests.

Mayúscula inicial

PorJosé A. Alonso 3-noviembre-201427-diciembre-2014

Enunciado

-- Definir la función
--    mayusculaInicial :: String -> String
-- tal que (mayusculaInicial xs) es la palabra xs con la letra inicial
-- en mayúscula y las restantes en minúsculas. Por ejemplo, 
--    mayusculaInicial "sEviLLa"  ==  "Sevilla"

-- Definir la función

-- mayusculaInicial :: String -> String

-- tal que (mayusculaInicial xs) es la palabra xs con la letra inicial

-- en mayúscula y las restantes en minúsculas. Por ejemplo,

-- mayusculaInicial "sEviLLa" == "Sevilla"

Soluciones

import Data.Char

-- 1ª definición (por comprensión):
mayusculaInicial :: String -> String
mayusculaInicial [] = []
mayusculaInicial (x:xs) = toUpper x : [toLower x | x <- xs]

-- 2ª definición (por recursión):
mayusculaInicialRec :: String -> String
mayusculaInicialRec [] = []
mayusculaInicialRec (x:xs) = toUpper x : aux xs
    where aux (x:xs) = toLower x : aux xs
          aux []     = []

import Data.Char

-- 1ª definición (por comprensión):

mayusculaInicial :: String -> String

mayusculaInicial [] = []

mayusculaInicial (x:xs) = toUpper x : [toLower x | x <- xs]

-- 2ª definición (por recursión):

mayusculaInicialRec :: String -> String

mayusculaInicialRec [] = []

mayusculaInicialRec (x:xs) = toUpper x : aux xs

where aux (x:xs) = toLower x : aux xs

aux [] = []

Parte impar de un número

PorJosé A. Alonso 2-noviembre-201427-diciembre-2014

Enunciado

-- Todo número entero positivo n se puede escribir como 2^k*m, con m impar.
-- Se dice que m es la parte impar de n. Por ejemplo, la parte impar de 40
-- es 5 porque 40 = 5*2^3.
-- 
-- Definir la función 
--    parteImpar :: Integer -> Integer
-- tal que (parteImpar n) es la parte impar de n. Por ejemplo,
--    parteImpar 40  ==  5

-- Todo número entero positivo n se puede escribir como 2^k*m, con m impar.

-- Se dice que m es la parte impar de n. Por ejemplo, la parte impar de 40

-- es 5 porque 40 = 5*2^3.

-- Definir la función

-- parteImpar :: Integer -> Integer

-- tal que (parteImpar n) es la parte impar de n. Por ejemplo,

-- parteImpar 40 == 5

Soluciones

parteImpar :: Integer -> Integer
parteImpar n | even n    = parteImpar (n `div` 2)
             | otherwise = n

parteImpar :: Integer -> Integer

parteImpar n | even n = parteImpar (n `div` 2)

| otherwise = n

Elementos no repetidos

PorJosé A. Alonso 1-noviembre-201425-abril-2021

Enunciado

-- Definir la función 
--    noRepetidos :: Eq a => [a] -> [a]
-- tal que (noRepetidos xs) es la lista de los elementos no repetidos de
-- la lista xs. Por ejemplo,
--    noRepetidos [3,2,5,2,4,7,3]  ==  [5,4,7]
--    noRepetidos "noRepetidos"    ==  "nRptids"
--    noRepetidos "Roma"           ==  "Roma"

-- Definir la función

-- noRepetidos :: Eq a => [a] -> [a]

-- tal que (noRepetidos xs) es la lista de los elementos no repetidos de

-- la lista xs. Por ejemplo,

-- noRepetidos [3,2,5,2,4,7,3] == [5,4,7]

-- noRepetidos "noRepetidos" == "nRptids"

-- noRepetidos "Roma" == "Roma"

Soluciones

import Test.QuickCheck

-- 1ª solución (por comprensión):
noRepetidos :: Eq a => [a] -> [a]
noRepetidos xs = 
    [x | x <- xs, ocurrencias x xs == 1]

-- (ocurrencias x ys) es el número de ocurrencias de x en ys. Por
-- ejemplo,
--    ocurrencias 3 [3,2,5,2,4,7,3]  ==  2
--    ocurrencias 5 [3,2,5,2,4,7,3]  ==  1
ocurrencias :: Eq a => a -> [a] -> Int
ocurrencias x ys = 
    length [y | y <- ys, y == x]

-- 2ª definición (por recursión):
noRepetidos2 :: Eq a => [a] -> [a]
noRepetidos2 [] = []
noRepetidos2 (x:xs) | elem x xs = noRepetidos2 [y | y <- xs, y /= x]
                    | otherwise = x : noRepetidos2 xs

-- La propiedad de equivalencia es
prop_equivalencia :: [Int] -> Bool
prop_equivalencia xs =
    noRepetidos xs == noRepetidos2 xs

-- La comprobación es
--    ghci> quickCheck prop_equivalencia
--    +++ OK, passed 100 tests.

import Test.QuickCheck

-- 1ª solución (por comprensión):

noRepetidos :: Eq a => [a] -> [a]

noRepetidos xs =

[x | x <- xs, ocurrencias x xs == 1]

-- (ocurrencias x ys) es el número de ocurrencias de x en ys. Por

-- ejemplo,

-- ocurrencias 3 [3,2,5,2,4,7,3] == 2

-- ocurrencias 5 [3,2,5,2,4,7,3] == 1

ocurrencias :: Eq a => a -> [a] -> Int

ocurrencias x ys =

length [y | y <- ys, y == x]

-- 2ª definición (por recursión):

noRepetidos2 :: Eq a => [a] -> [a]

noRepetidos2 [] = []

noRepetidos2 (x:xs) | elem x xs = noRepetidos2 [y | y <- xs, y /= x]

| otherwise = x : noRepetidos2 xs

-- La propiedad de equivalencia es

prop_equivalencia :: [Int] -> Bool

prop_equivalencia xs =

noRepetidos xs == noRepetidos2 xs

-- La comprobación es

-- ghci> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

Listas equidigitales

PorJosé A. Alonso 31-octubre-201425-abril-2021

Enunciado

-- Una lista de números naturales es equidigital si todos sus elementos
-- tienen el mismo número de dígitos.
-- 
-- Definir la función
--    equidigital :: [Int] -> Bool
-- tal que (equidigital xs) se verifica si xs es una lista equidigital. 
-- Por ejemplo,
--    equidigital [343,225,777,943]   ==  True
--    equidigital [343,225,777,94,3]  ==  False

-- Una lista de números naturales es equidigital si todos sus elementos

-- tienen el mismo número de dígitos.

-- Definir la función

-- equidigital :: [Int] -> Bool

-- tal que (equidigital xs) se verifica si xs es una lista equidigital.

-- Por ejemplo,

-- equidigital [343,225,777,943] == True

-- equidigital [343,225,777,94,3] == False

Soluciones

-- 1ª definición (por comprensión)
equidigital :: [Int] -> Bool
equidigital []     = True
equidigital (x:xs) = and [nCifras y == n | y <- xs]
    where n = nCifras x

-- (nCifras x) es el número de cifras de x. Por ejemplo,
--    nCifras 475  ==  3
nCifras :: Int -> Int
nCifras x = length (show x)

-- 2ª definición (por recursión)
equidigital2 :: [Int] -> Bool
equidigital2 (x:y:zs) = nCifras x == nCifras y && equidigital (y:zs)
equidigital2 _        = True

-- 1ª definición (por comprensión)

equidigital :: [Int] -> Bool

equidigital [] = True

equidigital (x:xs) = and [nCifras y == n | y <- xs]

where n = nCifras x

-- (nCifras x) es el número de cifras de x. Por ejemplo,

-- nCifras 475 == 3

nCifras :: Int -> Int

nCifras x = length (show x)

-- 2ª definición (por recursión)

equidigital2 :: [Int] -> Bool

equidigital2 (x:y:zs) = nCifras x == nCifras y && equidigital (y:zs)

equidigital2 _ = True

Divisibles por el primero

PorJosé A. Alonso 30-octubre-201427-diciembre-2014

Enunciado

-- Definir la función
--    divisiblesPorPrimero :: [Int] -> Bool
-- tal que (divisibles xs) se verifica si todos los elementos positivos
-- de xs son divisibles por el primero. Por ejemplo,
--    divisiblesPorPrimero [2,6,-3,0,18,-17,10]  ==  True
--    divisiblesPorPrimero [-13]                 ==  True
--    divisiblesPorPrimero [-3,6,1,-3,9,18]      ==  False
--    divisiblesPorPrimero [5,-2,-6,3]           ==  False
--    divisiblesPorPrimero []                    ==  False
--    divisiblesPorPrimero [0,2,4]               ==  False

-- Definir la función

-- divisiblesPorPrimero :: [Int] -> Bool

-- tal que (divisibles xs) se verifica si todos los elementos positivos

-- de xs son divisibles por el primero. Por ejemplo,

-- divisiblesPorPrimero [2,6,-3,0,18,-17,10] == True

-- divisiblesPorPrimero [-13] == True

-- divisiblesPorPrimero [-3,6,1,-3,9,18] == False

-- divisiblesPorPrimero [5,-2,-6,3] == False

-- divisiblesPorPrimero [] == False

-- divisiblesPorPrimero [0,2,4] == False

Soluciones

-- 1ª definición (por comprensión)
divisiblesPorPrimero1 :: [Int] -> Bool
divisiblesPorPrimero1 []     = False
divisiblesPorPrimero1 (0:_)  = False
divisiblesPorPrimero1 (x:xs) = and [y `rem` x == 0 | y <- xs, y > 0]

-- 2ª definición (por recursión)
divisiblesPorPrimero2 :: [Int] -> Bool
divisiblesPorPrimero2 []     = False
divisiblesPorPrimero2 (0:_)  = False
divisiblesPorPrimero2 (x:xs) = aux xs
    where aux [] = True
          aux (y:ys) | y > 0     = y `rem` x == 0 && aux ys
                     | otherwise = aux ys

-- 1ª definición (por comprensión)

divisiblesPorPrimero1 :: [Int] -> Bool

divisiblesPorPrimero1 [] = False

divisiblesPorPrimero1 (0:_) = False

divisiblesPorPrimero1 (x:xs) = and [y `rem` x == 0 | y <- xs, y > 0]

-- 2ª definición (por recursión)

divisiblesPorPrimero2 :: [Int] -> Bool

divisiblesPorPrimero2 [] = False

divisiblesPorPrimero2 (0:_) = False

divisiblesPorPrimero2 (x:xs) = aux xs

where aux [] = True

aux (y:ys) | y > 0 = y `rem` x == 0 && aux ys

| otherwise = aux ys

Laberinto numérico

PorJosé A. Alonso 25-julio-201425-marzo-2022

Enunciado

-- El problema del laberinto numérico consiste en, dados un par de
-- números, encontrar la longitud del camino más corto entre ellos
-- usando sólo las siguientes operaciones:  
--    * multiplicar por 2,
--    * dividir por 2 (sólo para los pares) y
--    * sumar 2.
-- Por ejemplo, un camino mínimo 
--    * de  3 a 12 es [3,6,12], 
--    * de 12 a  3 es [12,6,3], 
--    * de  9 a  2 es [9,18,20,10,12,6,8,4,2] y 
--    * de  2 a  9 es [2,4,8,16,18,9].
-- 
-- Definir la función
--    longitudCaminoMinimo :: Int -> Int -> Int
-- tal que (longitudCaminoMinimo x y) es la longitud del camino mínimo
-- desde x hasta y en el laberinto numérico. 
--    longitudCaminoMinimo 3 12  ==  2
--    longitudCaminoMinimo 12 3  ==  2
--    longitudCaminoMinimo 9 2   ==  8
--    longitudCaminoMinimo 2 9   ==  5

-- El problema del laberinto numérico consiste en, dados un par de

-- números, encontrar la longitud del camino más corto entre ellos

-- usando sólo las siguientes operaciones:

-- * multiplicar por 2,

-- * dividir por 2 (sólo para los pares) y

-- * sumar 2.

-- Por ejemplo, un camino mínimo

-- * de 3 a 12 es [3,6,12],

-- * de 12 a 3 es [12,6,3],

-- * de 9 a 2 es [9,18,20,10,12,6,8,4,2] y

-- * de 2 a 9 es [2,4,8,16,18,9].

-- Definir la función

-- longitudCaminoMinimo :: Int -> Int -> Int

-- tal que (longitudCaminoMinimo x y) es la longitud del camino mínimo

-- desde x hasta y en el laberinto numérico.

-- longitudCaminoMinimo 3 12 == 2

-- longitudCaminoMinimo 12 3 == 2

-- longitudCaminoMinimo 9 2 == 8

-- longitudCaminoMinimo 2 9 == 5

Soluciones

longitudCaminoMinimo :: Int -> Int -> Int
longitudCaminoMinimo x y = 
    head [n | n <- [1..], y `elem` orbita n [x]] 

-- (orbita n xs) es el conjunto de números que se pueden obtener aplicando 
-- como máximo n veces las operaciones a los elementos de xs. Por ejemplo, 
--    orbita 0 [12]  ==  [12]
--    orbita 1 [12]  ==  [6,12,14,24]
--    orbita 2 [12]  ==  [3,6,7,8,12,14,16,24,26,28,48]
orbita :: Int -> [Int] -> [Int]
orbita 0 xs = sort xs
orbita n xs = sort (nub (ys ++ concat [sucesores x | x <- ys]))
    where ys = orbita (n-1) xs
          sucesores x | odd x     = [2*x, x+2]
                      | otherwise = [2*x, x `div` 2, x+2]

longitudCaminoMinimo :: Int -> Int -> Int

longitudCaminoMinimo x y =

head [n | n <- [1..], y `elem` orbita n [x]]

-- (orbita n xs) es el conjunto de números que se pueden obtener aplicando

-- como máximo n veces las operaciones a los elementos de xs. Por ejemplo,

-- orbita 0 [12] == [12]

-- orbita 1 [12] == [6,12,14,24]

-- orbita 2 [12] == [3,6,7,8,12,14,16,24,26,28,48]

orbita :: Int -> [Int] -> [Int]

orbita 0 xs = sort xs

orbita n xs = sort (nub (ys ++ concat [sucesores x | x <- ys]))

where ys = orbita (n-1) xs

sucesores x | odd x = [2*x, x+2]

| otherwise = [2*x, x `div` 2, x+2]

Sustitución en una expresión

PorJosé A. Alonso 24-julio-201427-diciembre-2014

Enunciado

-- La expresiones aritméticas se pueden representar mediante el
-- siguiente tipo  
--    data Expr = V Char 
--              | N Int 
--              | S Expr Expr
--              | P Expr Expr
--              deriving Show
-- por ejemplo, representa la expresión "z*(3+x)" se representa por
-- (P (V 'z') (S (N 3) (V 'x'))). 
--
-- Definir la función
--    sustitucion :: Expr -> [(Char, Int)] -> Expr
-- tal que (sustitucion e s) es la expresión obtenida sustituyendo las
-- variables de la expresión e según se indica en la sustitución s. Por
-- ejemplo, 
--    ghci> sustitucion (P (V 'z') (S (N 3) (V 'x'))) [('x',7),('z',9)]
--    P (N 9) (S (N 3) (N 7))
--    ghci> sustitucion (P (V 'z') (S (N 3) (V 'y'))) [('x',7),('z',9)]
--    P (N 9) (S (N 3) (V 'y'))

-- La expresiones aritméticas se pueden representar mediante el

-- siguiente tipo

-- data Expr = V Char

-- | N Int

-- | S Expr Expr

-- | P Expr Expr

-- deriving Show

-- por ejemplo, representa la expresión "z*(3+x)" se representa por

-- (P (V 'z') (S (N 3) (V 'x'))).

-- Definir la función

-- sustitucion :: Expr -> [(Char, Int)] -> Expr

-- tal que (sustitucion e s) es la expresión obtenida sustituyendo las

-- variables de la expresión e según se indica en la sustitución s. Por

-- ejemplo,

-- ghci> sustitucion (P (V 'z') (S (N 3) (V 'x'))) [('x',7),('z',9)]

-- P (N 9) (S (N 3) (N 7))

-- ghci> sustitucion (P (V 'z') (S (N 3) (V 'y'))) [('x',7),('z',9)]

-- P (N 9) (S (N 3) (V 'y'))

Soluciones

data Expr = V Char 
          | N Int 
          | S Expr Expr
          | P Expr Expr
          deriving Show

sustitucion :: Expr -> [(Char, Int)] -> Expr
sustitucion e [] = e
sustitucion (V c) ((d,n):ps) | c == d = N n
                             | otherwise = sustitucion (V c) ps
sustitucion (N n) _ = N n                                 
sustitucion (S e1 e2) ps = S (sustitucion e1 ps) (sustitucion e2 ps)
sustitucion (P e1 e2) ps = P (sustitucion e1 ps) (sustitucion e2 ps)

data Expr = V Char

| N Int

| S Expr Expr

| P Expr Expr

deriving Show

sustitucion :: Expr -> [(Char, Int)] -> Expr

sustitucion e [] = e

sustitucion (V c) ((d,n):ps) | c == d = N n

| otherwise = sustitucion (V c) ps

sustitucion (N n) _ = N n

sustitucion (S e1 e2) ps = S (sustitucion e1 ps) (sustitucion e2 ps)

sustitucion (P e1 e2) ps = P (sustitucion e1 ps) (sustitucion e2 ps)

Cadenas de ceros y unos

PorJosé A. Alonso 22-julio-20141-mayo-2015

-- Definir la constante
--    cadenasDe0y1 :: [String]
-- tal que cadenasDe0y1 es la cadena de ceros y unos. Por ejemplo,
--    ghci> take 10 cadenasDe0y1
--    ["","0","1","00","10","01","11","000","100","010"]

-- Definir la constante

-- cadenasDe0y1 :: [String]

-- tal que cadenasDe0y1 es la cadena de ceros y unos. Por ejemplo,

-- ghci> take 10 cadenasDe0y1

-- ["","0","1","00","10","01","11","000","100","010"]

Soluciones

cadenasDe0y1 :: [String]
cadenasDe0y1 = "" : concat [['0':cs, '1':cs] | cs <- cadenasDe0y1]

1 2	cadenasDe0y1 :: [String] cadenasDe0y1 = "" : concat [['0':cs, '1':cs] \| cs <- cadenasDe0y1]

Elemento más cercano que cumple una propiedad

PorJosé A. Alonso 9-julio-201426-marzo-2022

-- Definir la función
--    cercano :: (a -> Bool) -> Int -> [a] -> Maybe a
-- tal que (cercano p n xs) es el elemento de xs más cercano a n que
-- verifica la propiedad p. La búsqueda comienza en n y los elementos se
-- analizan en el siguiente orden: n, n+1, n-1, n+2, n-2,... Por ejemplo, 
--    cercano (`elem` "aeiou") 6 "Sevilla"     ==  Just 'a'
--    cercano (`elem` "aeiou") 1 "Sevilla"     ==  Just 'e'
--    cercano (`elem` "aeiou") 2 "Sevilla"     ==  Just 'i'
--    cercano (`elem` "aeiou") 5 "Sevilla"     ==  Just 'a'
--    cercano (`elem` "aeiou") 9 "Sevilla"     ==  Just 'a'
--    cercano (`elem` "aeiou") (-3) "Sevilla"  ==  Just 'e'
--    cercano (>100) 4 [200,1,150,2,4]         ==  Just 150
--    cercano even 5 [1,3..99]                 ==  Nothing

-- Definir la función

-- cercano :: (a -> Bool) -> Int -> [a] -> Maybe a

-- tal que (cercano p n xs) es el elemento de xs más cercano a n que

-- verifica la propiedad p. La búsqueda comienza en n y los elementos se

-- analizan en el siguiente orden: n, n+1, n-1, n+2, n-2,... Por ejemplo,

-- cercano (`elem` "aeiou") 6 "Sevilla" == Just 'a'

-- cercano (`elem` "aeiou") 1 "Sevilla" == Just 'e'

-- cercano (`elem` "aeiou") 2 "Sevilla" == Just 'i'

-- cercano (`elem` "aeiou") 5 "Sevilla" == Just 'a'

-- cercano (`elem` "aeiou") 9 "Sevilla" == Just 'a'

-- cercano (`elem` "aeiou") (-3) "Sevilla" == Just 'e'

-- cercano (>100) 4 [200,1,150,2,4] == Just 150

-- cercano even 5 [1,3..99] == Nothing

Soluciones

import Data.List

-- 1ª solución
-- ===========

cercano1 :: (a -> Bool) -> Int -> [a] -> Maybe a
cercano1 p n xs | null ys   = Nothing
                | otherwise = Just (head ys)
    where ys = filter p (ordenaPorCercanos xs n)

-- (ordenaPorCercanos xs n) es la lista de los elementos de xs que
-- ocupan las posiciones n, n+1, n-1, n+2, n-2... Por ejemplo, 
--    ordenaPorCercanos [0..9] 4     ==  [4,5,3,6,2,7,1,8,0,9]
--    ordenaPorCercanos [0..9] 7     ==  [7,8,6,9,5,4,3,2,1,0]
--    ordenaPorCercanos [0..9] 2     ==  [2,3,1,4,0,5,6,7,8,9]
--    ordenaPorCercanos [0..9] (-3)  ==  [0,1,2,3,4,5,6,7,8,9]
--    ordenaPorCercanos [0..9] 20    ==  [9,8,7,6,5,4,3,2,1,0]
ordenaPorCercanos :: [a] -> Int -> [a]
ordenaPorCercanos xs n 
    | n < 0          = xs
    | n >= length xs = reverse xs
    | otherwise      = z : intercala zs (reverse ys)
    where (ys,(z:zs)) = splitAt n xs

-- (intercala xs ys) es la lista obtenida intercalando los elementos de
-- las lista xs e ys. Por ejemplo,
--    intercala [1..4] [5..10]   ==  [1,5,2,6,3,7,4,8,9,10]
--    intercala [5..10] [1..4]   ==  [5,1,6,2,7,3,8,4,9,10]
intercala :: [a] -> [a] -> [a]
intercala [] ys = ys
intercala xs [] = xs
intercala (x:xs) (y:ys) = x : y : intercala xs ys

-- 2ª solución (usando find)
-- =========================

cercano2 :: (a -> Bool) -> Int -> [a] -> Maybe a
cercano2 p n xs = find p (ordenaPorCercanos xs n)

import Data.List

-- 1ª solución

-- ===========

cercano1 :: (a -> Bool) -> Int -> [a] -> Maybe a

cercano1 p n xs | null ys = Nothing

| otherwise = Just (head ys)

where ys = filter p (ordenaPorCercanos xs n)

-- (ordenaPorCercanos xs n) es la lista de los elementos de xs que

-- ocupan las posiciones n, n+1, n-1, n+2, n-2... Por ejemplo,

-- ordenaPorCercanos [0..9] 4 == [4,5,3,6,2,7,1,8,0,9]

-- ordenaPorCercanos [0..9] 7 == [7,8,6,9,5,4,3,2,1,0]

-- ordenaPorCercanos [0..9] 2 == [2,3,1,4,0,5,6,7,8,9]

-- ordenaPorCercanos [0..9] (-3) == [0,1,2,3,4,5,6,7,8,9]

-- ordenaPorCercanos [0..9] 20 == [9,8,7,6,5,4,3,2,1,0]

ordenaPorCercanos :: [a] -> Int -> [a]

ordenaPorCercanos xs n

| n < 0 = xs

| n >= length xs = reverse xs

| otherwise = z : intercala zs (reverse ys)

where (ys,(z:zs)) = splitAt n xs

-- (intercala xs ys) es la lista obtenida intercalando los elementos de

-- las lista xs e ys. Por ejemplo,

-- intercala [1..4] [5..10] == [1,5,2,6,3,7,4,8,9,10]

-- intercala [5..10] [1..4] == [5,1,6,2,7,3,8,4,9,10]

intercala :: [a] -> [a] -> [a]

intercala [] ys = ys

intercala xs [] = xs

intercala (x:xs) (y:ys) = x : y : intercala xs ys

-- 2ª solución (usando find)

-- =========================

cercano2 :: (a -> Bool) -> Int -> [a] -> Maybe a

cercano2 p n xs = find p (ordenaPorCercanos xs n)

Referencia

El ejercicio está basado en el problema del 12 de mayo de 1HaskellADay.

Divide si todos son múltiplos

PorJosé A. Alonso 4-julio-201426-marzo-2022

Ejercicio. Definir la función

   divideSiTodosMultiplos :: Integral a => a -> [a] -> Maybe [a]

1	divideSiTodosMultiplos :: Integral a => a -> [a] -> Maybe [a]

tal que (divideSiTodosMultiplos x ys) es justo la lista de los cocientes de los elementos de ys entre x si todos son múltiplos de x y Nothing en caso contrario. Por ejemplo,

   divideSiTodosMultiplos 2 [6,10,4]  ==  Just [3,5,2]
   divideSiTodosMultiplos 2 [6,10,5]  ==  Nothing

1 2	divideSiTodosMultiplos 2 [6,10,4] == Just [3,5,2] divideSiTodosMultiplos 2 [6,10,5] == Nothing

Soluciones

-- 1ª definición (por comprensión)
divideSiTodosMultiplos :: Integral a => a -> [a] -> Maybe [a]
divideSiTodosMultiplos x ys
    | todosMultiplos x ys = Just [y `div` x | y <- ys]
    | otherwise           = Nothing

-- (todosMultiplos x ys) se verifica si todos los elementos de ys son
-- múltiplos de x. Por ejemplo,
--    todosMultiplos 2 [6,10,4]  ==  True
--    todosMultiplos 2 [6,10,5]  ==  False
todosMultiplos :: Integral a => a -> [a] -> Bool
todosMultiplos x ys = and [y `mod` x == 0 | y <- ys]

-- 2ª definición (por recursión)
divideSiTodosMultiplos2 :: Integral a => a -> [a] -> Maybe [a]
divideSiTodosMultiplos2 _ [] = Just []
divideSiTodosMultiplos2 x (y:ys)
    | y `mod` x /= 0 = Nothing
    | aux == Nothing  = Nothing
    | otherwise       = Just ((y `div` x) : zs)
    where aux     = divideSiTodosMultiplos2 x ys
          Just zs = aux

-- 1ª definición (por comprensión)

divideSiTodosMultiplos :: Integral a => a -> [a] -> Maybe [a]

divideSiTodosMultiplos x ys

| todosMultiplos x ys = Just [y `div` x | y <- ys]

| otherwise = Nothing

-- (todosMultiplos x ys) se verifica si todos los elementos de ys son

-- múltiplos de x. Por ejemplo,

-- todosMultiplos 2 [6,10,4] == True

-- todosMultiplos 2 [6,10,5] == False

todosMultiplos :: Integral a => a -> [a] -> Bool

todosMultiplos x ys = and [y `mod` x == 0 | y <- ys]

-- 2ª definición (por recursión)

divideSiTodosMultiplos2 :: Integral a => a -> [a] -> Maybe [a]

divideSiTodosMultiplos2 _ [] = Just []

divideSiTodosMultiplos2 x (y:ys)

| y `mod` x /= 0 = Nothing

| aux == Nothing = Nothing

| otherwise = Just ((y `div` x) : zs)

where aux = divideSiTodosMultiplos2 x ys

Just zs = aux

Renombramiento de un árbol

PorJosé A. Alonso 3-julio-201427-diciembre-2014

-- Los árboles binarios se pueden representar mediante el tipo Arbol definido
-- por
--    data Arbol a = H a 
--                 | N a (Arbol a) (Arbol a)
--                 deriving Show
-- Por ejemplo, el árbol
--         "C"
--         / \ 
--        /   \
--       /     \
--     "B"     "A"
--     / \     / \
--   "A" "B" "B" "C" 
-- se puede definir por 
--    ej1 :: Arbol String
--    ej1 = N "C" (N "B" (H "A") (H "B")) (N "A" (H "B") (H "C"))
--
-- Definir la función
--    renombraArbol :: Arbol t -> Arbol Int
-- tal que (renombraArbol a) es el árbol obtenido sustituyendo el valor
-- de los nodos y hojas por números tales que tengan el mismo valor si y
-- sólo si coincide su contenido. Por ejemplo,
--    ghci> renombraArbol ej1
--    N 2 (N 1 (H 0) (H 1)) (N 0 (H 1) (H 2))
-- Gráficamente, 
--          2 
--         / \ 
--        /   \
--       /     \
--      1       0 
--     / \     / \
--    0   1   1   2

-- Los árboles binarios se pueden representar mediante el tipo Arbol definido

-- por

-- data Arbol a = H a

-- | N a (Arbol a) (Arbol a)

-- deriving Show

-- Por ejemplo, el árbol

-- "C"

-- / \

-- "B" "A"

-- / \ / \

-- "A" "B" "B" "C"

-- se puede definir por

-- ej1 :: Arbol String

-- ej1 = N "C" (N "B" (H "A") (H "B")) (N "A" (H "B") (H "C"))

-- Definir la función

-- renombraArbol :: Arbol t -> Arbol Int

-- tal que (renombraArbol a) es el árbol obtenido sustituyendo el valor

-- de los nodos y hojas por números tales que tengan el mismo valor si y

-- sólo si coincide su contenido. Por ejemplo,

-- ghci> renombraArbol ej1

-- N 2 (N 1 (H 0) (H 1)) (N 0 (H 1) (H 2))

-- Gráficamente,

-- 2

-- / \

-- 1 0

-- / \ / \

-- 0 1 1 2

Soluciones

import Data.List 

data Arbol a = H a
             | N a (Arbol a) (Arbol a) 
             deriving (Show, Eq)

ej1 :: Arbol String
ej1 = N "C" (N "B" (H "A") (H "B")) (N "A" (H "B") (H "C"))

renombraArbol :: Ord t => Arbol t -> Arbol Int
renombraArbol a = aux a
    where ys            = valores a
          aux (H x)     = H (posicion x ys)
          aux (N x i d) = N (posicion x ys) (aux i) (aux d) 

-- (valores a) es la lista de los valores en los nodos y las hojas del
-- árbol a. Por ejemplo,
--    valores ej1  ==  ["A","B","C"]
valores :: Ord a => Arbol a -> [a]
valores a = sort (nub (aux a))
    where aux (H x)     = [x]
          aux (N x i d) = x : (aux i ++ aux d)

-- (posicion x ys) es la posición de x en ys. Por ejemplo.
--    posicion 7 [5,3,7,8]  ==  2
posicion :: Eq a => a -> [a] -> Int
posicion x ys = head [n | (y,n) <- zip ys [0..], y == x]

import Data.List

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving (Show, Eq)

ej1 :: Arbol String

ej1 = N "C" (N "B" (H "A") (H "B")) (N "A" (H "B") (H "C"))

renombraArbol :: Ord t => Arbol t -> Arbol Int

renombraArbol a = aux a

where ys = valores a

aux (H x) = H (posicion x ys)

aux (N x i d) = N (posicion x ys) (aux i) (aux d)

-- (valores a) es la lista de los valores en los nodos y las hojas del

-- árbol a. Por ejemplo,

-- valores ej1 == ["A","B","C"]

valores :: Ord a => Arbol a -> [a]

valores a = sort (nub (aux a))

where aux (H x) = [x]

aux (N x i d) = x : (aux i ++ aux d)

-- (posicion x ys) es la posición de x en ys. Por ejemplo.

-- posicion 7 [5,3,7,8] == 2

posicion :: Eq a => a -> [a] -> Int

posicion x ys = head [n | (y,n) <- zip ys [0..], y == x]

Sopa de letras

PorJosé A. Alonso 26-junio-201426-marzo-2022

Enunciado

-- Las matrices se puede representar mediante tablas cuyos índices son
-- pares de números naturales:  
--    type Matriz a = Array (Int,Int) a
-- 
-- Definir la función 
--    enLaSopa :: Eq a => [a] -> Matriz a -> Bool
-- tal que (enLaSopa c p) se verifica si c está en la matriz p en
-- horizontal o en vertical. Por ejemplo, si p es la matriz siguiente:
--    p :: Matriz Char
--    p = listaMatriz ["mjtholueq",
--                     "juhoolauh",
--                     "dariouhyj",
--                     "rngkploaa"]
-- entonces,
--    enLaSopa "dar"  p  ==  True   -- En horizontal a la derecha en la 3ª fila
--    enLaSopa "oir"  p  ==  True   -- En horizontal a la izquierda en la 3ª fila
--    enLaSopa "juan" p  ==  True   -- En vertical descendente en la 2ª columna
--    enLaSopa "kio"  p  ==  True   -- En vertical ascendente en la 3ª columna
--    enLaSopa "Juan" p  ==  False
--    enLaSopa "hola" p  ==  False
-- 
-- Nota. Para resolverlo, se puede usar la función isInfixOf.

-- Las matrices se puede representar mediante tablas cuyos índices son

-- pares de números naturales:

-- type Matriz a = Array (Int,Int) a

-- Definir la función

-- enLaSopa :: Eq a => [a] -> Matriz a -> Bool

-- tal que (enLaSopa c p) se verifica si c está en la matriz p en

-- horizontal o en vertical. Por ejemplo, si p es la matriz siguiente:

-- p :: Matriz Char

-- p = listaMatriz ["mjtholueq",

-- "juhoolauh",

-- "dariouhyj",

-- "rngkploaa"]

-- entonces,

-- enLaSopa "dar" p == True -- En horizontal a la derecha en la 3ª fila

-- enLaSopa "oir" p == True -- En horizontal a la izquierda en la 3ª fila

-- enLaSopa "juan" p == True -- En vertical descendente en la 2ª columna

-- enLaSopa "kio" p == True -- En vertical ascendente en la 3ª columna

-- enLaSopa "Juan" p == False

-- enLaSopa "hola" p == False

-- Nota. Para resolverlo, se puede usar la función isInfixOf.

Soluciones

-- Auxiliares
-- ==========

type Matriz a = Array (Int,Int) a

p :: Matriz Char
p = listaMatriz ["mjtholueq",
                 "juhoolauh",
                 "dariouhyj",
                 "rngkploaa"]

-- 1ª solución
-- ===========

enLaSopa1 :: Eq a => [a] -> Matriz a -> Bool
enLaSopa1 c p = 
    or [isInfixOf c xs | 
        xs <- [[p!(i,j) | j <- [1..n]]     | i <- [1..m]] ++
              [[p!(i,j) | j <- [n,n-1..1]] | i <- [1..m]] ++
              [[p!(i,j) | i <- [1..m]]     | j <- [1..n]] ++
              [[p!(i,j) | i <- [m,m-1..1]] | j <- [1..n]]]
    where (_,(m,n)) = bounds p

-- 2ª solución
-- ===========

enLaSopa2 :: Eq a => [a] -> Matriz a -> Bool
enLaSopa2 c p = estaEnHorizontal c p || estaEnVertical c p 

estaEnHorizontal :: Eq a => [a] -> Matriz a -> Bool
estaEnHorizontal c p =
    or [isInfixOf c xs | xs <- filasL p ++ map reverse (filasL p)]

filasL :: Matriz a -> [[a]]
filasL p = [filaMat i p | i <-[1..numFilas p]]

estaEnVertical :: Eq a => [a] -> Matriz a -> Bool
estaEnVertical c p =
    or [isInfixOf c xs | xs <- columnasL p ++ map reverse (columnasL p)]

columnasL :: Matriz a -> [[a]]
columnasL p = [columnaMat j p | j <- [1..numColumnas p]]

listaMatriz :: [[a]] -> Matriz a
listaMatriz xss = listArray ((1,1),(m,n)) (concat xss)
    where m = length xss
          n = length (head xss)

numFilas :: Matriz a -> Int
numFilas = fst . snd . bounds

numColumnas:: Matriz a -> Int
numColumnas = snd . snd . bounds

filaMat :: Int -> Matriz a -> [a]
filaMat i p = [p!(i,j) | j <- [1..n]]
    where n = numColumnas p

columnaMat :: Int -> Matriz a -> [a]
columnaMat j p = [p!(i,j) | i <- [1..m]]
    where m = numFilas p

-- Auxiliares

-- ==========

type Matriz a = Array (Int,Int) a

p :: Matriz Char

p = listaMatriz ["mjtholueq",

"juhoolauh",

"dariouhyj",

"rngkploaa"]

-- 1ª solución

-- ===========

enLaSopa1 :: Eq a => [a] -> Matriz a -> Bool

enLaSopa1 c p =

or [isInfixOf c xs |

xs <- [[p!(i,j) | j <- [1..n]] | i <- [1..m]] ++

[[p!(i,j) | j <- [n,n-1..1]] | i <- [1..m]] ++

[[p!(i,j) | i <- [1..m]] | j <- [1..n]] ++

[[p!(i,j) | i <- [m,m-1..1]] | j <- [1..n]]]

where (_,(m,n)) = bounds p

-- 2ª solución

-- ===========

enLaSopa2 :: Eq a => [a] -> Matriz a -> Bool

enLaSopa2 c p = estaEnHorizontal c p || estaEnVertical c p

estaEnHorizontal :: Eq a => [a] -> Matriz a -> Bool

estaEnHorizontal c p =

or [isInfixOf c xs | xs <- filasL p ++ map reverse (filasL p)]

filasL :: Matriz a -> [[a]]

filasL p = [filaMat i p | i <-[1..numFilas p]]

estaEnVertical :: Eq a => [a] -> Matriz a -> Bool

estaEnVertical c p =

or [isInfixOf c xs | xs <- columnasL p ++ map reverse (columnasL p)]

columnasL :: Matriz a -> [[a]]

columnasL p = [columnaMat j p | j <- [1..numColumnas p]]

listaMatriz :: [[a]] -> Matriz a

listaMatriz xss = listArray ((1,1),(m,n)) (concat xss)

where m = length xss

n = length (head xss)

numFilas :: Matriz a -> Int

numFilas = fst . snd . bounds

numColumnas:: Matriz a -> Int

numColumnas = snd . snd . bounds

filaMat :: Int -> Matriz a -> [a]

filaMat i p = [p!(i,j) | j <- [1..n]]

where n = numColumnas p

columnaMat :: Int -> Matriz a -> [a]

columnaMat j p = [p!(i,j) | i <- [1..m]]

where m = numFilas p

Entero positivo de la cadena

PorJosé A. Alonso 24-junio-201426-marzo-2022

Enunciado

-- Definir la función
--    enteroPositivo :: String -> Maybe Int
-- tal que (enteroPositivo cs) es justo el contenido de la cadena cs, si
-- dicho contenido es un entero positivo, y Nothing en caso contrario. 
-- Por ejemplo, 
--    enteroPositivo "235"    ==  Just 235
--    enteroPositivo "-235"   ==  Nothing
--    enteroPositivo "23.5"   ==  Nothing
--    enteroPositivo "235 "   ==  Nothing
--    enteroPositivo "cinco"  ==  Nothing
--    enteroPositivo ""       ==  Nothing

-- Definir la función

-- enteroPositivo :: String -> Maybe Int

-- tal que (enteroPositivo cs) es justo el contenido de la cadena cs, si

-- dicho contenido es un entero positivo, y Nothing en caso contrario.

-- Por ejemplo,

-- enteroPositivo "235" == Just 235

-- enteroPositivo "-235" == Nothing

-- enteroPositivo "23.5" == Nothing

-- enteroPositivo "235 " == Nothing

-- enteroPositivo "cinco" == Nothing

-- enteroPositivo "" == Nothing

Soluciones

enteroPositivo :: String -> Maybe Int
enteroPositivo ""                   = Nothing
enteroPositivo cs | todosDigitos cs = Just (read cs)
                  | otherwise       = Nothing

-- (todosDigitos cs) se verifica si todos los elementos de cs son
-- dígitos. Por ejemplo,
--    todosDigitos "235"    ==  True
--    todosDigitos "-235"   ==  False
--    todosDigitos "23.5"   ==  False
--    todosDigitos "235 "   ==  False
--    todosDigitos "cinco"  ==  False

-- 1ª definición de todosDigitos (por comprensión):
todosDigitos :: String -> Bool
todosDigitos cs = and [esDigito c | c <- cs]

-- 2ª definición de todosDigitos (por recursión):
todosDigitos2 :: String -> Bool
todosDigitos2 []     = True
todosDigitos2 (c:cs) = esDigito c && todosDigitos2 cs

-- 3ª definición de todosDigitos (por recursión):
todosDigitos3 :: String -> Bool
todosDigitos3 = foldr ((&&) . esDigito) True

-- 4ª definición de todosDigitos (con all):
todosDigitos4 :: String -> Bool
todosDigitos4 = all esDigito

-- (esDigito c) se verifica si el carácter c es un dígito. Por ejemplo,
--    esDigito '5'  ==  True
--    esDigito 'a'  ==  False

-- 1ª definición de esDigito:
esDigito1 :: Char -> Bool
esDigito1 c = c `elem` "0123456789"

-- 2ª definición de esDigito:
esDigito2 :: Char -> Bool
esDigito2 c = c `elem` ['0'..'9']

-- 3ª definición de esDigito:
esDigito3 :: Char -> Bool
esDigito3 = (`elem` ['0'..'9'])

-- 4ª definición de esDigito:
esDigito4 :: Char -> Bool
esDigito4 c = '0' <= c && c <= '9'

-- 5ª definición de esDigito:
esDigito5 :: Char -> Bool
esDigito5 = isDigit

-- Usaremos como definición de esDigito la 5ª:
esDigito :: Char -> Bool
esDigito = esDigito5

enteroPositivo :: String -> Maybe Int

enteroPositivo "" = Nothing

enteroPositivo cs | todosDigitos cs = Just (read cs)

| otherwise = Nothing

-- (todosDigitos cs) se verifica si todos los elementos de cs son

-- dígitos. Por ejemplo,

-- todosDigitos "235" == True

-- todosDigitos "-235" == False

-- todosDigitos "23.5" == False

-- todosDigitos "235 " == False

-- todosDigitos "cinco" == False

-- 1ª definición de todosDigitos (por comprensión):

todosDigitos :: String -> Bool

todosDigitos cs = and [esDigito c | c <- cs]

-- 2ª definición de todosDigitos (por recursión):

todosDigitos2 :: String -> Bool

todosDigitos2 [] = True

todosDigitos2 (c:cs) = esDigito c && todosDigitos2 cs

-- 3ª definición de todosDigitos (por recursión):

todosDigitos3 :: String -> Bool

todosDigitos3 = foldr ((&&) . esDigito) True

-- 4ª definición de todosDigitos (con all):

todosDigitos4 :: String -> Bool

todosDigitos4 = all esDigito

-- (esDigito c) se verifica si el carácter c es un dígito. Por ejemplo,

-- esDigito '5' == True

-- esDigito 'a' == False

-- 1ª definición de esDigito:

esDigito1 :: Char -> Bool

esDigito1 c = c `elem` "0123456789"

-- 2ª definición de esDigito:

esDigito2 :: Char -> Bool

esDigito2 c = c `elem` ['0'..'9']

-- 3ª definición de esDigito:

esDigito3 :: Char -> Bool

esDigito3 = (`elem` ['0'..'9'])

-- 4ª definición de esDigito:

esDigito4 :: Char -> Bool

esDigito4 c = '0' <= c && c <= '9'

-- 5ª definición de esDigito:

esDigito5 :: Char -> Bool

esDigito5 = isDigit

-- Usaremos como definición de esDigito la 5ª:

esDigito :: Char -> Bool

esDigito = esDigito5

Filtro booleano

PorJosé A. Alonso 23-junio-201426-marzo-2022

Enunciado

-- Definir la función
--    filtroBooleano :: [Bool] -> [a] -> [Maybe a]
-- tal que (filtroBooleano xs ys) es la lista de los elementos de ys
-- tales que el elemento de xs en la misma posición es verdadero. Por
-- ejemplo, 
--    ghci> filtroBooleano [True,False,True] "Sevilla"
--    [Just 'S',Nothing,Just 'v']
--    ghci> filtroBooleano (repeat True) "abc"
--    [Just 'a',Just 'b',Just 'c']
--    ghci> take 3 (filtroBooleano (repeat True) [1..])
--    [Just 1,Just 2,Just 3]
--    ghci> take 3 (filtroBooleano (repeat False) [1..])
--    [Nothing,Nothing,Nothing]
--    ghci> take 3 (filtroBooleano (cycle [True,False]) [1..])
--    [Just 1,Nothing,Just 3]

-- Definir la función

-- filtroBooleano :: [Bool] -> [a] -> [Maybe a]

-- tal que (filtroBooleano xs ys) es la lista de los elementos de ys

-- tales que el elemento de xs en la misma posición es verdadero. Por

-- ejemplo,

-- ghci> filtroBooleano [True,False,True] "Sevilla"

-- [Just 'S',Nothing,Just 'v']

-- ghci> filtroBooleano (repeat True) "abc"

-- [Just 'a',Just 'b',Just 'c']

-- ghci> take 3 (filtroBooleano (repeat True) [1..])

-- [Just 1,Just 2,Just 3]

-- ghci> take 3 (filtroBooleano (repeat False) [1..])

-- [Nothing,Nothing,Nothing]

-- ghci> take 3 (filtroBooleano (cycle [True,False]) [1..])

-- [Just 1,Nothing,Just 3]

Soluciones

-- 1ª solución (por comprensión):
filtroBooleano1 :: [Bool] -> [a] -> [Maybe a]
filtroBooleano1 xs ys = [f (x,y) | (x,y) <- zip xs ys]
    where f (x,y) | x         = Just y
                  | otherwise = Nothing

-- 2ª solución (con zipWith):
filtroBooleano2 :: [Bool] -> [a] -> [Maybe a]
filtroBooleano2 = zipWith f
    where f x y  | x         = Just y
                 | otherwise = Nothing

-- 3ª solución (con zipWith y lambda):
filtroBooleano3 :: [Bool] -> [a] -> [Maybe a]
filtroBooleano3 = zipWith (\x y -> if x then Just y else Nothing)

-- 4ª solución (por recursión):
filtroBooleano4 :: [Bool] -> [a] -> [Maybe a]
filtroBooleano4 (x:xs) (y:ys) | x         = Just y : filtroBooleano4 xs ys
                              | otherwise = Nothing : filtroBooleano4 xs ys
filtroBooleano4 _ _                       = []

-- 1ª solución (por comprensión):

filtroBooleano1 :: [Bool] -> [a] -> [Maybe a]

filtroBooleano1 xs ys = [f (x,y) | (x,y) <- zip xs ys]

where f (x,y) | x = Just y

| otherwise = Nothing

-- 2ª solución (con zipWith):

filtroBooleano2 :: [Bool] -> [a] -> [Maybe a]

filtroBooleano2 = zipWith f

where f x y | x = Just y

| otherwise = Nothing

-- 3ª solución (con zipWith y lambda):

filtroBooleano3 :: [Bool] -> [a] -> [Maybe a]

filtroBooleano3 = zipWith (\x y -> if x then Just y else Nothing)

-- 4ª solución (por recursión):

filtroBooleano4 :: [Bool] -> [a] -> [Maybe a]

filtroBooleano4 (x:xs) (y:ys) | x = Just y : filtroBooleano4 xs ys

| otherwise = Nothing : filtroBooleano4 xs ys

filtroBooleano4 _ _ = []

Mayor sucesión del problema 3n+1

PorJosé A. Alonso 20-junio-20141-mayo-2016

Enunciado

-- La sucesión 3n+1 generada por un número entero positivo x es la
-- sucesión generada por el siguiente algoritmo: Se empieza con el
-- número x. Si x es par, se divide entre 2. Si x es impar, se
-- multiplica por 3 y se le suma 1. El  proceso se repite con el número
-- obtenido hasta que se alcanza el valor 1. Por ejemplo, la sucesión de
-- números generadas cuando se empieza en 22 es
--    22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1
-- Se ha conjeturado (aunque no demostrado) que este algoritmo siempre
-- alcanza el 1 empezando en cualquier entero positivo.
-- 
-- Definir la función
--    mayorLongitud :: Integer -> Integer -> Integer
-- tal que (mayorLongitud i j) es el máximo de las longitudes de las
-- sucesiones 3n+1 para todos los números comprendidos entre i y j,
-- ambos inclusives. Por ejemplo,
--    mayorLongitud   1   10  ==  20
--    mayorLongitud 100  200  ==  125
--    mayorLongitud 201  210  ==  89
--    mayorLongitud 900 1000  ==  174

-- La sucesión 3n+1 generada por un número entero positivo x es la

-- sucesión generada por el siguiente algoritmo: Se empieza con el

-- número x. Si x es par, se divide entre 2. Si x es impar, se

-- multiplica por 3 y se le suma 1. El proceso se repite con el número

-- obtenido hasta que se alcanza el valor 1. Por ejemplo, la sucesión de

-- números generadas cuando se empieza en 22 es

-- 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1

-- Se ha conjeturado (aunque no demostrado) que este algoritmo siempre

-- alcanza el 1 empezando en cualquier entero positivo.

-- Definir la función

-- mayorLongitud :: Integer -> Integer -> Integer

-- tal que (mayorLongitud i j) es el máximo de las longitudes de las

-- sucesiones 3n+1 para todos los números comprendidos entre i y j,

-- ambos inclusives. Por ejemplo,

-- mayorLongitud 1 10 == 20

-- mayorLongitud 100 200 == 125

-- mayorLongitud 201 210 == 89

-- mayorLongitud 900 1000 == 174

Soluciones

-- 1ª solución
-- ===========

mayorLongitud1 :: Int -> Int -> Int
mayorLongitud1 i j = maximum [length (sucesion k) | k <- [i..j]]

-- (sucesion n) es la sucesión 3n+1 generada por n. Por ejemplo, 
--    sucesion 22  ==  [22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1]
sucesion :: Int -> [Int]
sucesion 1 = [1]
sucesion n | even n    = n : sucesion (n `div` 2)
           | otherwise = n : sucesion (3*n+1)

-- 2ª solución
-- ===========

mayorLongitud2 :: Int -> Int -> Int
mayorLongitud2 i j = maximum [longitud k | k <- [i..j]]

-- (longitud n) es la longitud de la sucesión 3n+1 generada por n. Por
-- ejemplo, 
--    longitud 22  ==  16
longitud :: Int -> Int
longitud 1 = 1
longitud n | even n    = 1 + longitud (n `div` 2)
           | otherwise = 1 + longitud (3*n+1)

-- 3ª solución (con iterate)
-- =========================

mayorLongitud3 :: Int -> Int -> Int
mayorLongitud3 i j = maximum [length (sucesion2 k) | k <- [i..j]]

-- (sucesion2 n) es la sucesión 3n+1 generada por n. Por ejemplo, 
--    sucesion2 22  ==  [22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1]
sucesion2 :: Int -> [Int]
sucesion2 n = takeWhile (/=1) (iterate f n) ++ [1]
    where f x | even x    = x `div` 2
              | otherwise = 3*x+1

-- 1ª solución

-- ===========

mayorLongitud1 :: Int -> Int -> Int

mayorLongitud1 i j = maximum [length (sucesion k) | k <- [i..j]]

-- (sucesion n) es la sucesión 3n+1 generada por n. Por ejemplo,

-- sucesion 22 == [22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1]

sucesion :: Int -> [Int]

sucesion 1 = [1]

sucesion n | even n = n : sucesion (n `div` 2)

| otherwise = n : sucesion (3*n+1)

-- 2ª solución

-- ===========

mayorLongitud2 :: Int -> Int -> Int

mayorLongitud2 i j = maximum [longitud k | k <- [i..j]]

-- (longitud n) es la longitud de la sucesión 3n+1 generada por n. Por

-- ejemplo,

-- longitud 22 == 16

longitud :: Int -> Int

longitud 1 = 1

longitud n | even n = 1 + longitud (n `div` 2)

| otherwise = 1 + longitud (3*n+1)

-- 3ª solución (con iterate)

-- =========================

mayorLongitud3 :: Int -> Int -> Int

mayorLongitud3 i j = maximum [length (sucesion2 k) | k <- [i..j]]

-- (sucesion2 n) es la sucesión 3n+1 generada por n. Por ejemplo,

-- sucesion2 22 == [22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1]

sucesion2 :: Int -> [Int]

sucesion2 n = takeWhile (/=1) (iterate f n) ++ [1]

where f x | even x = x `div` 2

| otherwise = 3*x+1

Referencia

El ejercicio está basado en The 3n + 1 problem de UVa Online Judge.

Selección hasta el primero que falla inclusive

PorJosé A. Alonso 18-junio-201429-noviembre-2014

Enunciado

-- Definir la función
--    seleccionConFallo :: (a -> Bool) -> [a] -> [a]
-- tal que (seleccionConFallo p xs) es la lista de los elementos de xs
-- que cumplen el predicado p hasta el primero que no lo cumple
-- inclusive. Por ejemplo,
--    seleccionConFallo (<5) [3,2,5,7,1,0]  ==  [3,2,5]
--    seleccionConFallo odd [1..4]          ==  [1,2]
--    seleccionConFallo odd [1,3,5]         ==  [1,3,5]
--    seleccionConFallo (<5) [10..20]       ==  [10]

-- Definir la función

-- seleccionConFallo :: (a -> Bool) -> [a] -> [a]

-- tal que (seleccionConFallo p xs) es la lista de los elementos de xs

-- que cumplen el predicado p hasta el primero que no lo cumple

-- inclusive. Por ejemplo,

-- seleccionConFallo (<5) [3,2,5,7,1,0] == [3,2,5]

-- seleccionConFallo odd [1..4] == [1,2]

-- seleccionConFallo odd [1,3,5] == [1,3,5]

-- seleccionConFallo (<5) [10..20] == [10]

Soluciones

-- 1ª solución (por recursión):
seleccionConFallo1 :: (a -> Bool) -> [a] -> [a]
seleccionConFallo1 p []                 = []
seleccionConFallo1 p (x:xs) | p x       = x : seleccionConFallo1 p xs
                            | otherwise = [x]

-- 2ª solución (con span):
seleccionConFallo2 :: (a -> Bool) -> [a] -> [a]
seleccionConFallo2 p xs = ys ++ take 1 zs
    where (ys,zs) = span p xs

-- 1ª solución (por recursión):

seleccionConFallo1 :: (a -> Bool) -> [a] -> [a]

seleccionConFallo1 p [] = []

seleccionConFallo1 p (x:xs) | p x = x : seleccionConFallo1 p xs

| otherwise = [x]

-- 2ª solución (con span):

seleccionConFallo2 :: (a -> Bool) -> [a] -> [a]

seleccionConFallo2 p xs = ys ++ take 1 zs

where (ys,zs) = span p xs

Referencia

El ejercicio está basado en el problema del 29 de abril de 1HaskellADay.

Descomposiciones como sumas de n sumandos

PorJosé A. Alonso 17-junio-201429-noviembre-2014

Enunciado

-- Definir la función
--    sumas :: (Num a, Ord a) => Int -> [a] -> a -> [[a]]
-- tal que (sumas n ys x) es la lista de las descomposiciones de x como
-- sumas de n sumandos en la lista ns. Por ejemplo,
--    sumas 2 [1,2] 3    ==  [[1,2],[2,1]]
--    sumas 2 [1,2] 4    ==  [[2,2]]
--    sumas 2 [1,2] 5    ==  []
--    sumas 3 [1,2] 5    ==  [[1,2,2],[2,1,2],[2,2,1]]
--    sumas 3 [1,2] 6    ==  [[2,2,2]]
--    sumas 2 [1,2,5] 6  ==  [[1,5],[5,1]]

-- Definir la función

-- sumas :: (Num a, Ord a) => Int -> [a] -> a -> [[a]]

-- tal que (sumas n ys x) es la lista de las descomposiciones de x como

-- sumas de n sumandos en la lista ns. Por ejemplo,

-- sumas 2 [1,2] 3 == [[1,2],[2,1]]

-- sumas 2 [1,2] 4 == [[2,2]]

-- sumas 2 [1,2] 5 == []

-- sumas 3 [1,2] 5 == [[1,2,2],[2,1,2],[2,2,1]]

-- sumas 3 [1,2] 6 == [[2,2,2]]

-- sumas 2 [1,2,5] 6 == [[1,5],[5,1]]

Soluciones

sumas :: (Num a, Ord a) => Int -> [a] -> a -> [[a]]
sumas 1 ys x | x `elem` ys = [[x]]
             | otherwise   = []
sumas n ys x = 
    concat [[y:zs | zs <- sumas (n-1) ys (x-y)] | y <- ys, y <= x]

sumas :: (Num a, Ord a) => Int -> [a] -> a -> [[a]]

sumas 1 ys x | x `elem` ys = [[x]]

| otherwise = []

sumas n ys x =

concat [[y:zs | zs <- sumas (n-1) ys (x-y)] | y <- ys, y <= x]

Referencia

El ejercicio está basado en el problema del 11 de junio de 1HaskellADay.

Órbita prima

PorJosé A. Alonso 13-junio-20141-mayo-2016

Enunciado

-- La órbita prima de un número n es la sucesión construida de la
-- siguiente forma: 
--    * si n es compuesto su órbita no tiene elementos 
--    * si n es primo, entonces n está en su órbita; además, sumamos n y
--      sus dígitos, si el resultado es un número primo repetimos el
--      proceso hasta obtener un número compuesto. 
-- Por ejemplo, con el 11 podemos repetir el proceso dos veces
--    13 = 11+1+1
--    17 = 13+1+3
-- Así, la órbita prima de 11 es 11, 13, 17. 
-- 
-- Definir la función
--    orbita :: Integer -> [Integer]
-- tal que (orbita n) es la órbita prima de n. Por ejemplo,
--    orbita 11 == [11,13,17]
--    orbita 59 == [59,73,83]
-- Calcular el menor número cuya órbita prima tiene más de 3 elementos.

-- La órbita prima de un número n es la sucesión construida de la

-- siguiente forma:

-- * si n es compuesto su órbita no tiene elementos

-- * si n es primo, entonces n está en su órbita; además, sumamos n y

-- sus dígitos, si el resultado es un número primo repetimos el

-- proceso hasta obtener un número compuesto.

-- Por ejemplo, con el 11 podemos repetir el proceso dos veces

-- 13 = 11+1+1

-- 17 = 13+1+3

-- Así, la órbita prima de 11 es 11, 13, 17.

-- Definir la función

-- orbita :: Integer -> [Integer]

-- tal que (orbita n) es la órbita prima de n. Por ejemplo,

-- orbita 11 == [11,13,17]

-- orbita 59 == [59,73,83]

-- Calcular el menor número cuya órbita prima tiene más de 3 elementos.

Soluciones

-- 1ª definición (por recursión)
-- =============================

orbita1 :: Integer -> [Integer]
orbita1 n | not (esPrimo n) = []
          | otherwise       = n : orbita1 (n + sum (cifras n))

esPrimo :: Integer -> Bool
esPrimo n = [x | x <- [1..n], n `rem` x == 0] == [1,n] 

cifras :: Integer -> [Integer]
cifras n = [read [x]| x <- show n]

-- El cálculo es
--    ghci> head [x | x <- [1,3..], length (orbita x) > 3]
--    277
-- 
--    ghci> orbita 277
--    [277,293,307,317]

-- 2ª definición (con iterate)
-- ===========================

orbita2 :: Integer -> [Integer]
orbita2 n = takeWhile esPrimo (iterate f n)
    where f x = x + sum (cifras x)

-- 1ª definición (por recursión)

-- =============================

orbita1 :: Integer -> [Integer]

orbita1 n | not (esPrimo n) = []

| otherwise = n : orbita1 (n + sum (cifras n))

esPrimo :: Integer -> Bool

esPrimo n = [x | x <- [1..n], n `rem` x == 0] == [1,n]

cifras :: Integer -> [Integer]

cifras n = [read [x]| x <- show n]

-- El cálculo es

-- ghci> head [x | x <- [1,3..], length (orbita x) > 3]

-- 277

-- ghci> orbita 277

-- [277,293,307,317]

-- 2ª definición (con iterate)

-- ===========================

orbita2 :: Integer -> [Integer]

orbita2 n = takeWhile esPrimo (iterate f n)

where f x = x + sum (cifras x)

Ordenada cíclicamente

PorJosé A. Alonso 12-junio-201421-abril-2022

Enunciado

-- Se dice que una sucesión x(1), ..., x(n) está ordenada cíclicamente
-- si existe un índice i tal que la sucesión  
--    x(i), x(i+1), ..., x(n), x(1), ..., x(i-1)
-- está ordenada crecientemente. 
-- 
-- Definir la función 
--    ordenadaCiclicamente :: Ord a => [a] -> Int
-- tal que (ordenadaCiclicamente xs) es el índice (empezando en 1) a
-- partir del cual está ordenada, si el la lista está ordenado cíclicamente
-- y 0 en caso contrario. Por ejemplo,
--    ordenadaCiclicamente [1,2,3,4]      ==  1  
--    ordenadaCiclicamente [5,8,2,3]      ==  3 
--    ordenadaCiclicamente [4,6,7,5,4,3]  ==  0 
--    ordenadaCiclicamente [1,0,1,2]      ==  0
--    ordenadaCiclicamente [0,2,0]        ==  3
--    ordenadaCiclicamente "cdeab"        ==  4

-- Se dice que una sucesión x(1), ..., x(n) está ordenada cíclicamente

-- si existe un índice i tal que la sucesión

-- x(i), x(i+1), ..., x(n), x(1), ..., x(i-1)

-- está ordenada crecientemente.

-- Definir la función

-- ordenadaCiclicamente :: Ord a => [a] -> Int

-- tal que (ordenadaCiclicamente xs) es el índice (empezando en 1) a

-- partir del cual está ordenada, si el la lista está ordenado cíclicamente

-- y 0 en caso contrario. Por ejemplo,

-- ordenadaCiclicamente [1,2,3,4] == 1

-- ordenadaCiclicamente [5,8,2,3] == 3

-- ordenadaCiclicamente [4,6,7,5,4,3] == 0

-- ordenadaCiclicamente [1,0,1,2] == 0

-- ordenadaCiclicamente [0,2,0] == 3

-- ordenadaCiclicamente "cdeab" == 4

Soluciones

-- 1ª definición (por comprensión)
-- ===============================

ordenadaCiclicamente1 :: Ord a => [a] -> Int
ordenadaCiclicamente1 xs = 
    primero [n+1 | n <- [0..length xs-1], 
                   ordenada (drop n xs ++ take n xs)]
    where primero []     = 0
          primero (x:xs) = x

-- (ordenada xs) se verifica si la lista xs está ordenada
-- crecientemente. Por ejemplo,
--   ordenada "acd"   ==  True
--   ordenada "acdb"  ==  False
ordenada :: Ord a => [a] -> Bool 
ordenada (x:y:zs) = x <= y && ordenada (y:zs) 
ordenada _        = True 
 
-- 2ª definición (por recursión)
-- =============================

ordenadaCiclicamente2 :: Ord a => [a] -> Int
ordenadaCiclicamente2 xs = aux xs 1 (length xs)  
    where aux xs i k 
              | i > k       = 0 
              | ordenada xs = i 
              | otherwise   = aux (siguienteCiclo xs) (i+1) k 

-- (siguienteCiclo xs) es la lista obtenida añadiendo el primer elemento
-- de xs al final del resto de xs. Por ejemplo,
--   siguienteCiclo [3,2,5]  =>  [2,5,3]
siguienteCiclo [] = [] 
siguienteCiclo (x:xs) = xs ++ [x]

-- 1ª definición (por comprensión)

-- ===============================

ordenadaCiclicamente1 :: Ord a => [a] -> Int

ordenadaCiclicamente1 xs =

primero [n+1 | n <- [0..length xs-1],

ordenada (drop n xs ++ take n xs)]

where primero [] = 0

primero (x:xs) = x

-- (ordenada xs) se verifica si la lista xs está ordenada

-- crecientemente. Por ejemplo,

-- ordenada "acd" == True

-- ordenada "acdb" == False

ordenada :: Ord a => [a] -> Bool

ordenada (x:y:zs) = x <= y && ordenada (y:zs)

ordenada _ = True

-- 2ª definición (por recursión)

-- =============================

ordenadaCiclicamente2 :: Ord a => [a] -> Int

ordenadaCiclicamente2 xs = aux xs 1 (length xs)

where aux xs i k

| i > k = 0

| ordenada xs = i

| otherwise = aux (siguienteCiclo xs) (i+1) k

-- (siguienteCiclo xs) es la lista obtenida añadiendo el primer elemento

-- de xs al final del resto de xs. Por ejemplo,

-- siguienteCiclo [3,2,5] => [2,5,3]

siguienteCiclo [] = []

siguienteCiclo (x:xs) = xs ++ [x]

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Soluciones

Soluciones

Referencia

Soluciones

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Referencia

Enunciado

Soluciones

Referencia

Enunciado

Soluciones

Referencia

Enunciado

Soluciones

Enunciado

Soluciones

Entradas recientes

Buscar

Correo electrónico