Medio – Página 14

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

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.

Rompecabeza matemático

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

Enunciado

-- Definir una función
--    f :: Int -> Int
-- tal que para todo n, f(f(n)) = -n y comprobar con QuickCheck que se
-- cumple la propiedad
--    prop_f :: Int -> Bool
--    prop_f n = f (f n) == -n
-- es decir,
--    ghci> quickCheck prop_f
--    +++ OK, passed 100 tests.

-- Definir una función

-- f :: Int -> Int

-- tal que para todo n, f(f(n)) = -n y comprobar con QuickCheck que se

-- cumple la propiedad

-- prop_f :: Int -> Bool

-- prop_f n = f (f n) == -n

-- es decir,

-- ghci> quickCheck prop_f

-- +++ OK, passed 100 tests.

Soluciones

import Test.QuickCheck

-- 1ª definición (por casos)
f :: Int -> Int
f n | even n && n > 0 = n-1
    | even n && n < 0 = n+1
    | odd  n && n > 0 = -n-1
    | odd  n && n < 0 = -n+1
    | otherwise       = 0

-- La propiedad es
prop_f :: Int -> Bool
prop_f n = f (f n) == -n

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

-- 2ª definición (por casos y signo):
f2 :: Int -> Int
f2 n | even n    =  n - signum n
     | odd  n    = -n - signum n
     | otherwise = 0

-- La propiedad es
prop_f2 :: Int -> Bool
prop_f2 n = f2 (f2 n) == -n

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

-- 3ª solución (sin casos):
f3 :: Int -> Int
f3 n = n * (2 * mod n 2 - 1) + signum n

-- La propiedad es
prop_f3 :: Int -> Bool
prop_f3 n = f3 (f3 n) == -n

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

-- 4ª solución (sin casos):
f4 :: Int -> Int
f4 n = (-1)^(abs n)*n - signum n

-- La propiedad es
prop_f4 :: Int -> Bool
prop_f4 n = f4 (f4 n) == -n

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

import Test.QuickCheck

-- 1ª definición (por casos)

f :: Int -> Int

f n | even n && n > 0 = n-1

| even n && n < 0 = n+1

| odd n && n > 0 = -n-1

| odd n && n < 0 = -n+1

| otherwise = 0

-- La propiedad es

prop_f :: Int -> Bool

prop_f n = f (f n) == -n

-- La comprobación es

-- ghci> quickCheck prop_f

-- +++ OK, passed 100 tests.

-- 2ª definición (por casos y signo):

f2 :: Int -> Int

f2 n | even n = n - signum n

| odd n = -n - signum n

| otherwise = 0

-- La propiedad es

prop_f2 :: Int -> Bool

prop_f2 n = f2 (f2 n) == -n

-- La comprobación es

-- ghci> quickCheck prop_f2

-- +++ OK, passed 100 tests.

-- 3ª solución (sin casos):

f3 :: Int -> Int

f3 n = n * (2 * mod n 2 - 1) + signum n

-- La propiedad es

prop_f3 :: Int -> Bool

prop_f3 n = f3 (f3 n) == -n

-- La comprobación es

-- ghci> quickCheck prop_f3

-- +++ OK, passed 100 tests.

-- 4ª solución (sin casos):

f4 :: Int -> Int

f4 n = (-1)^(abs n)*n - signum n

-- La propiedad es

prop_f4 :: Int -> Bool

prop_f4 n = f4 (f4 n) == -n

-- La comprobación es

-- ghci> quickCheck prop_f4

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

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

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]

Inserción en árboles binarios de búsqueda

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

-- Un árbol binario de búsqueda (ABB) es un árbol binario tal que el de
-- cada nodo es mayor que los valores de su subárbol izquierdo y es
-- menor que los valores de su subárbol derecho y, además, ambos
-- subárboles son árboles binarios de búsqueda. Por ejemplo, al
-- almacenar los valores de [8,4,2,6,3] en un ABB se puede obtener el
-- siguiente ABB:
-- 
--       5 
--      / \
--     /   \ 
--    2     6 
--         / \ 
--        4   8 
-- 
-- Los ABB se pueden representar como tipo de dato algebraico:
--    data ABB = V
--             | N Int ABB ABB
--             deriving (Eq, Show)
-- Por ejemplo, la definición del ABB anteriore es
--    ej :: ABB
--    ej = N 3 (N 2 V V) (N 6 (N 4 V V) (N 8 V V))
--
-- Definir la función 
--    inserta :: Int -> ABB -> ABB
-- tal que (inserta v a) es el árbol binario de búsqueda 
-- obtenido añadiendo el valor v al ABB a, si no es uno 
-- de sus valores. Por ejemplo, 
--    ghci>  inserta 5 ej
--    N 3 (N 2 V V) (N 6 (N 4 V (N 5 V V)) (N 8 V V))
--    ghci>  inserta 1 ej
--    N 3 (N 2 (N 1 V V) V) (N 6 (N 4 V V) (N 8 V V))
--    ghci>  inserta 2 ej
--    N 3 (N 2 V V) (N 6 (N 4 V V) (N 8 V V))

-- Un árbol binario de búsqueda (ABB) es un árbol binario tal que el de

-- cada nodo es mayor que los valores de su subárbol izquierdo y es

-- menor que los valores de su subárbol derecho y, además, ambos

-- subárboles son árboles binarios de búsqueda. Por ejemplo, al

-- almacenar los valores de [8,4,2,6,3] en un ABB se puede obtener el

-- siguiente ABB:

-- 5

-- / \

-- 2 6

-- / \

-- 4 8

-- Los ABB se pueden representar como tipo de dato algebraico:

-- data ABB = V

-- | N Int ABB ABB

-- deriving (Eq, Show)

-- Por ejemplo, la definición del ABB anteriore es

-- ej :: ABB

-- ej = N 3 (N 2 V V) (N 6 (N 4 V V) (N 8 V V))

-- Definir la función

-- inserta :: Int -> ABB -> ABB

-- tal que (inserta v a) es el árbol binario de búsqueda

-- obtenido añadiendo el valor v al ABB a, si no es uno

-- de sus valores. Por ejemplo,

-- ghci> inserta 5 ej

-- N 3 (N 2 V V) (N 6 (N 4 V (N 5 V V)) (N 8 V V))

-- ghci> inserta 1 ej

-- N 3 (N 2 (N 1 V V) V) (N 6 (N 4 V V) (N 8 V V))

-- ghci> inserta 2 ej

-- N 3 (N 2 V V) (N 6 (N 4 V V) (N 8 V V))

Soluciones

data ABB = V
         | N Int ABB ABB
         deriving (Eq, Show)

ej :: ABB 
ej = N 3 (N 2 V V) (N 6 (N 4 V V) (N 8 V V))

inserta :: Int -> ABB -> ABB
inserta v1 V = N v1 V V
inserta v1 (N v i d) 
    | v1 == v   = N v i d
    | v1 < v    = N v (inserta v1 i) d
    | otherwise = N v i (inserta v1 d)

data ABB = V

| N Int ABB ABB

deriving (Eq, Show)

ej :: ABB

ej = N 3 (N 2 V V) (N 6 (N 4 V V) (N 8 V V))

inserta :: Int -> ABB -> ABB

inserta v1 V = N v1 V V

inserta v1 (N v i d)

| v1 == v = N v i d

| v1 < v = N v (inserta v1 i) d

| otherwise = N v i (inserta v1 d)

Sucesiones pucelanas

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

Introducción

En la Olimpiada de Matemática del 2010 se planteó el siguiente problema:

Una sucesión pucelana es una sucesión creciente de 16 números impares positivos consecutivos, cuya suma es un cubo perfecto. ¿Cuántas sucesiones pucelanas tienen solamente números de tres cifras?

Para resolverlo se propone el siguiente ejercicio.

Enunciado

-- Definir la función
--    pucelanasConNcifras :: Int -> [[Int]]
-- tal que (pucelanasConNcifras n) es la lista de las sucesiones
-- pucelanas que tienen solamente números de n cifras. Por ejemplo,
--    ghci> pucelanasConNcifras 2
--    [[17,19,21,23,25,27,29,31,33,35,37,39,41,43,45,47]]
-- Calcular cuántas sucesiones pucelanas tienen solamente números de
-- tres cifras.

-- Definir la función

-- pucelanasConNcifras :: Int -> [[Int]]

-- tal que (pucelanasConNcifras n) es la lista de las sucesiones

-- pucelanas que tienen solamente números de n cifras. Por ejemplo,

-- ghci> pucelanasConNcifras 2

-- [[17,19,21,23,25,27,29,31,33,35,37,39,41,43,45,47]]

-- Calcular cuántas sucesiones pucelanas tienen solamente números de

-- tres cifras.

Soluciones

pucelanasConNcifras :: Int -> [[Int]]
pucelanasConNcifras n = 
    [[x,x+2..x+30] | x <- [10^(n-1)+1..10^n-31],
                     esCubo (sum [x,x+2..x+30])]

-- (esCubo n) se verifica si n es un cubo. Por ejemplo,
--    esCubo 27  ==  True
--    esCubo 28  ==  False
esCubo x = y^3 == x
    where y = ceiling (fromIntegral x ** (1/3))

-- El cálculo es
--    ghci> length (pucelanasConNcifras 3)
--    3

pucelanasConNcifras :: Int -> [[Int]]

pucelanasConNcifras n =

[[x,x+2..x+30] | x <- [10^(n-1)+1..10^n-31],

esCubo (sum [x,x+2..x+30])]

-- (esCubo n) se verifica si n es un cubo. Por ejemplo,

-- esCubo 27 == True

-- esCubo 28 == False

esCubo x = y^3 == x

where y = ceiling (fromIntegral x ** (1/3))

-- El cálculo es

-- ghci> length (pucelanasConNcifras 3)

-- 3

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.

Ventana deslizante

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

-- Definir la función
--    ventanas :: Int -> Int -> [a] -> [[a]]
-- tal que (ventanas x y zs) es la lista de ventanas de zs de tamaño x
-- y deslizamiento y; es decir listas de x elementos consecutivos de zs
-- (salvo, posiblemente, la última que puede ser menor) tales que la
-- diferencia de posiciones entre los primeros elementos de ventanas
-- consecutivas es y. Por ejemplo, 
--    ventanas 3 2 [5,1,9,2] == [[5,1,9],[9,2]]
--    ventanas 3 3 [5,1,9,2] == [[5,1,9],[2]]
--    ventanas 3 4 [5,1,9,2] == [[5,1,9]]
--    ventanas 4 1 [1..7]    == [[1,2,3,4],[2,3,4,5],[3,4,5,6],[4,5,6,7]]
--    ventanas 4 2 [1..7]    == [[1,2,3,4],[3,4,5,6],[5,6,7]]
--    ventanas 4 3 [1..7]    == [[1,2,3,4],[4,5,6,7]]
--    ventanas 4 4 [1..7]    == [[1,2,3,4],[5,6,7]]
--    ventanas 4 5 [1..7]    == [[1,2,3,4],[6,7]]
--    ventanas 4 6 [1..7]    == [[1,2,3,4],[7]]
--    ventanas 4 7 [1..7]    == [[1,2,3,4]]
--    ventanas 4 8 [1..7]    == [[1,2,3,4]]
--    ventanas 3 2 "abcdef"  == ["abc","cde","ef"]
--    ventanas 3 3 "abcdef"  == ["abc","def"]
--    ventanas 3 4 "abcdef"  == ["abc","ef"]
--    ventanas 3 5 "abcdef"  == ["abc","f"]
--    ventanas 3 6 "abcdef"  == ["abc"]
--    ventanas 3 7 "abcdef"  == ["abc"]
--    ventanas 1 5 "abcdef"  == ["a","f"]

-- Definir la función

-- ventanas :: Int -> Int -> [a] -> [[a]]

-- tal que (ventanas x y zs) es la lista de ventanas de zs de tamaño x

-- y deslizamiento y; es decir listas de x elementos consecutivos de zs

-- (salvo, posiblemente, la última que puede ser menor) tales que la

-- diferencia de posiciones entre los primeros elementos de ventanas

-- consecutivas es y. Por ejemplo,

-- ventanas 3 2 [5,1,9,2] == [[5,1,9],[9,2]]

-- ventanas 3 3 [5,1,9,2] == [[5,1,9],[2]]

-- ventanas 3 4 [5,1,9,2] == [[5,1,9]]

-- ventanas 4 1 [1..7] == [[1,2,3,4],[2,3,4,5],[3,4,5,6],[4,5,6,7]]

-- ventanas 4 2 [1..7] == [[1,2,3,4],[3,4,5,6],[5,6,7]]

-- ventanas 4 3 [1..7] == [[1,2,3,4],[4,5,6,7]]

-- ventanas 4 4 [1..7] == [[1,2,3,4],[5,6,7]]

-- ventanas 4 5 [1..7] == [[1,2,3,4],[6,7]]

-- ventanas 4 6 [1..7] == [[1,2,3,4],[7]]

-- ventanas 4 7 [1..7] == [[1,2,3,4]]

-- ventanas 4 8 [1..7] == [[1,2,3,4]]

-- ventanas 3 2 "abcdef" == ["abc","cde","ef"]

-- ventanas 3 3 "abcdef" == ["abc","def"]

-- ventanas 3 4 "abcdef" == ["abc","ef"]

-- ventanas 3 5 "abcdef" == ["abc","f"]

-- ventanas 3 6 "abcdef" == ["abc"]

-- ventanas 3 7 "abcdef" == ["abc"]

-- ventanas 1 5 "abcdef" == ["a","f"]

Soluciones

import Data.List

-- 1º definición (por recursión):
ventanas1 :: Int -> Int -> [a] -> [[a]]
ventanas1 _ _ [] = []
ventanas1 x y zs 
    | length zs <= x = [zs]
    | otherwise      = take x zs : ventanas1 x y (drop y zs)

-- 2ª definición (con unfold):
ventanas2 :: Int -> Int -> [a] -> [[a]]
ventanas2 x y = unfoldr aux
  where aux [] = Nothing
        aux xs = Just (ys,zs)
                 where (ys,us)        = splitAt x xs
                       zs | null us   = []
                          | otherwise = drop y xs

import Data.List

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

ventanas1 :: Int -> Int -> [a] -> [[a]]

ventanas1 _ _ [] = []

ventanas1 x y zs

| length zs <= x = [zs]

| otherwise = take x zs : ventanas1 x y (drop y zs)

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

ventanas2 :: Int -> Int -> [a] -> [[a]]

ventanas2 x y = unfoldr aux

where aux [] = Nothing

aux xs = Just (ys,zs)

where (ys,us) = splitAt x xs

zs | null us = []

| otherwise = drop y xs

Referencia

El ejercicio está basado en el problema del 30 de abril de 2014 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

Límite de sucesiones

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

Enunciado

-- Ejercicio. Definir la función  
--    limite :: (Double -> Double) -> Double -> Double
-- tal que (limite f a) es el valor de f en el primer término x tal que, 
-- para todo y entre x+1 y x+100, el valor absoluto de la diferencia
-- entre f(y) y f(x) es menor que a. Por ejemplo,
--    limite (\n -> (2*n+1)/(n+5)) 0.001  ==  1.9900110987791344
--    limite (\n -> (1+1/n)**n) 0.001     ==  2.714072874546881

-- Ejercicio. Definir la función

-- limite :: (Double -> Double) -> Double -> Double

-- tal que (limite f a) es el valor de f en el primer término x tal que,

-- para todo y entre x+1 y x+100, el valor absoluto de la diferencia

-- entre f(y) y f(x) es menor que a. Por ejemplo,

-- limite (\n -> (2*n+1)/(n+5)) 0.001 == 1.9900110987791344

-- limite (\n -> (1+1/n)**n) 0.001 == 2.714072874546881

Soluciones

limite :: (Double -> Double) -> Double -> Double
limite f a = 
    head [f x | x <- [1..],
                maximum [abs(f y - f x) | y <- [x+1..x+100]] < a]

limite :: (Double -> Double) -> Double -> Double

limite f a =

head [f x | x <- [1..],

maximum [abs(f y - f x) | y <- [x+1..x+100]] < a]

Eliminación de n elementos

PorJosé A. Alonso 30-junio-201425-abril-2021

Enunciado

-- Definir la función
--    elimina :: Int -> [a] -> [[a]]
-- tal que (elimina n xs) es la lista de las listas obtenidas eliminando
-- n elementos de xs. Por ejemplo,
--    elimina 0 "abcd"  ==  ["abcd"]
--    elimina 1 "abcd"  ==  ["abc","abd","acd","bcd"]
--    elimina 2 "abcd"  ==  ["ab","ac","ad","bc","bd","cd"]
--    elimina 3 "abcd"  ==  ["a","b","c","d"]
--    elimina 4 "abcd"  ==  [""]
--    elimina 5 "abcd"  ==  []
--    elimina 6 "abcd"  ==  []

-- Definir la función

-- elimina :: Int -> [a] -> [[a]]

-- tal que (elimina n xs) es la lista de las listas obtenidas eliminando

-- n elementos de xs. Por ejemplo,

-- elimina 0 "abcd" == ["abcd"]

-- elimina 1 "abcd" == ["abc","abd","acd","bcd"]

-- elimina 2 "abcd" == ["ab","ac","ad","bc","bd","cd"]

-- elimina 3 "abcd" == ["a","b","c","d"]

-- elimina 4 "abcd" == [""]

-- elimina 5 "abcd" == []

-- elimina 6 "abcd" == []

Soluciones

-- 1ª solución:
elimina1 :: Int -> [a] -> [[a]]
elimina1 0 xs     = [xs]
elimina1 n []     = []
elimina1 n (x:xs) = [x:ys | ys <- elimina1 n xs] ++ elimina1 (n-1) xs

-- 2ª solución:
elimina2 :: Int -> [a] -> [[a]]
elimina2 n xs = [ys | ys <- subsequences xs, length ys == k]
    where k = length xs - n

-- 1ª solución:

elimina1 :: Int -> [a] -> [[a]]

elimina1 0 xs = [xs]

elimina1 n [] = []

elimina1 n (x:xs) = [x:ys | ys <- elimina1 n xs] ++ elimina1 (n-1) xs

-- 2ª solución:

elimina2 :: Int -> [a] -> [[a]]

elimina2 n xs = [ys | ys <- subsequences xs, length ys == k]

where k = length xs - n

Referencia

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

Intercalación de n copias

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

Enunciado

-- Definir la función 
--    intercala :: Int -> a -> [a] -> [[a]]
-- tal que (intercala n x ys) es la lista de la listas obtenidas
-- intercalando n copias de x en ys. Por ejemplo,
--    intercala 2 'a' "bc" == ["bcaa","baca","baac","abca","abac","aabc"]
--    intercala 2 'a' "c"  == ["caa","aca","aac"]
--    intercala 1 'a' "c"  == ["ca","ac"]
--    intercala 0 'a' "c"  == ["c"]
-- Nota: No importa el orden de los elementos.

-- Definir la función

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

-- tal que (intercala n x ys) es la lista de la listas obtenidas

-- intercalando n copias de x en ys. Por ejemplo,

-- intercala 2 'a' "bc" == ["bcaa","baca","baac","abca","abac","aabc"]

-- intercala 2 'a' "c" == ["caa","aca","aac"]

-- intercala 1 'a' "c" == ["ca","ac"]

-- intercala 0 'a' "c" == ["c"]

-- Nota: No importa el orden de los elementos.

Soluciones

import Data.List 

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

intercala1 :: Int -> a -> [a] -> [[a]]
intercala1 0 _ xs     = [xs]
intercala1 n y []     = [replicate n y]
intercala1 n y (x:xs) = 
    concat [[replicate i y ++ (x:zs) | zs <- intercala1 (n-i) y xs]
            | i <- [0..n]]

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

intercala2 :: Eq a => Int -> a -> [a] -> [[a]]
intercala2 n x ys = nub (aux n x ys)
    where 
      aux 0 _ ys = [ys]
      aux n x ys = concat [intercalaUno x zs | zs <- aux (n-1) x ys]

--    intercalaUno 'a' "bc"  == ["abc","bac","bca"]
intercalaUno :: a -> [a] -> [[a]]
intercalaUno x []     = [[x]]
intercalaUno x (y:ys) = (x:y:ys) : [y:zs | zs <- intercalaUno x ys]

import Data.List

-- 1ª solución

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

intercala1 :: Int -> a -> [a] -> [[a]]

intercala1 0 _ xs = [xs]

intercala1 n y [] = [replicate n y]

intercala1 n y (x:xs) =

concat [[replicate i y ++ (x:zs) | zs <- intercala1 (n-i) y xs]

| i <- [0..n]]

-- 2ª solución

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

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

intercala2 n x ys = nub (aux n x ys)

where

aux 0 _ ys = [ys]

aux n x ys = concat [intercalaUno x zs | zs <- aux (n-1) x ys]

-- intercalaUno 'a' "bc" == ["abc","bac","bca"]

intercalaUno :: a -> [a] -> [[a]]

intercalaUno x [] = [[x]]

intercalaUno x (y:ys) = (x:y:ys) : [y:zs | zs <- intercalaUno x ys]

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

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.

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

Soluciones

Soluciones

Introducción

Enunciado

Soluciones

Soluciones

Referencia

Soluciones

Referencia

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Referencia

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Referencia

Enunciado

Soluciones

Referencia

Enunciado

Soluciones

Entradas recientes

Buscar

Correo electrónico