Orden superior – Página 18

2015 y los números con factorización capicúa

PorJosé A. Alonso 1-enero-20151-mayo-2016

Un número tiene factorización capicúa si puede escribir como un producto de números primos tal que la concatenación de sus dígitos forma un número capicúa. Por ejemplo, el 2015 tiene factorización capicúa ya que 2015 = 13·5·31, los factores son primos y su concatenación es 13531 que es capicúa.

Definir la sucesión

   conFactorizacionesCapicuas :: [Int]

1	conFactorizacionesCapicuas :: [Int]

formada por los números que tienen factorización capicúa. Por ejemplo,

   ghci> take 20 conFactorizacionesCapicuas
   [1,2,3,4,5,7,8,9,11,12,16,18,20,25,27,28,32,36,39,44]

1 2	ghci> take 20 conFactorizacionesCapicuas [1,2,3,4,5,7,8,9,11,12,16,18,20,25,27,28,32,36,39,44]

Usando conFactorizacionesCapicuas escribir expresiones cuyos valores sean las respuestas a las siguientes preguntas y calcularlas

¿Qué lugar ocupa el 2015 en la sucesión?
¿Cuál fue el anterior año con factorización capicúa?
¿Cuál será el siguiente año con factorización capicúa?

Soluciones

import Data.List (permutations)

conFactorizacionesCapicuas :: [Int]
conFactorizacionesCapicuas =
    [n | n <- [1..], not (null (factorizacionesCapicua n))]

-- (factorizacionesCapicua n) es la lista de las factorizaciones
-- capicúas de n. Por ejemplo,
--    factorizacionesCapicua 2015  ==  [[13,5,31],[31,5,13]]
factorizacionesCapicua :: Int -> [[Int]]
factorizacionesCapicua n =
    [xs | xs <- permutations (factorizacion n),
          esCapicuaConcatenacion xs]

-- (factorizacion n) es la lista de todos los factores primos de n; es
-- decir, es una lista de números primos cuyo producto es n. Por ejemplo,
--    factorizacion 300  ==  [2,2,3,5,5]
factorizacion :: Int -> [Int]
factorizacion n | n == 1    = []
                | otherwise = x : factorizacion (div n x)
    where x = menorFactor n

-- (menorFactor n) es el menor factor primo de n. Por ejemplo,
--    menorFactor 15  ==  3
--    menorFactor 16  ==  2
--    menorFactor 17  == 17
menorFactor :: Int -> Int
menorFactor n = head [x | x <- [2..], rem n x == 0]

-- (esCapicuaConcatenacion xs) se verifica si la concatenación de los
-- números de xs es capicúa. Por ejemplo,
--    esCapicuaConcatenacion [13,5,31]   ==  True
--    esCapicuaConcatenacion [135,31]    ==  True
--    esCapicuaConcatenacion [135,21]    ==  False
esCapicuaConcatenacion :: [Int] -> Bool
esCapicuaConcatenacion xs = ys == reverse ys
    where ys = concat (map show xs)

-- El cálculo de la 1ª respuesta es
--    ghci> length (takeWhile (<= 2015) conFactorizacionesCapicuas)
--    265

-- El cálculo de la 2ª respuesta es
--    ghci> last (takeWhile (<2015) conFactorizacionesCapicuas)
--    2001

-- El cálculo de la 3ª respuesta es
--    ghci> head (dropWhile (<=2015) conFactorizacionesCapicuas)
--    2023

import Data.List (permutations)

conFactorizacionesCapicuas :: [Int]

conFactorizacionesCapicuas =

[n | n <- [1..], not (null (factorizacionesCapicua n))]

-- (factorizacionesCapicua n) es la lista de las factorizaciones

-- capicúas de n. Por ejemplo,

-- factorizacionesCapicua 2015 == [[13,5,31],[31,5,13]]

factorizacionesCapicua :: Int -> [[Int]]

factorizacionesCapicua n =

[xs | xs <- permutations (factorizacion n),

esCapicuaConcatenacion xs]

-- (factorizacion n) es la lista de todos los factores primos de n; es

-- decir, es una lista de números primos cuyo producto es n. Por ejemplo,

-- factorizacion 300 == [2,2,3,5,5]

factorizacion :: Int -> [Int]

factorizacion n | n == 1 = []

| otherwise = x : factorizacion (div n x)

where x = menorFactor n

-- (menorFactor n) es el menor factor primo de n. Por ejemplo,

-- menorFactor 15 == 3

-- menorFactor 16 == 2

-- menorFactor 17 == 17

menorFactor :: Int -> Int

menorFactor n = head [x | x <- [2..], rem n x == 0]

-- (esCapicuaConcatenacion xs) se verifica si la concatenación de los

-- números de xs es capicúa. Por ejemplo,

-- esCapicuaConcatenacion [13,5,31] == True

-- esCapicuaConcatenacion [135,31] == True

-- esCapicuaConcatenacion [135,21] == False

esCapicuaConcatenacion :: [Int] -> Bool

esCapicuaConcatenacion xs = ys == reverse ys

where ys = concat (map show xs)

-- El cálculo de la 1ª respuesta es

-- ghci> length (takeWhile (<= 2015) conFactorizacionesCapicuas)

-- 265

-- El cálculo de la 2ª respuesta es

-- ghci> last (takeWhile (<2015) conFactorizacionesCapicuas)

-- 2001

-- El cálculo de la 3ª respuesta es

-- ghci> head (dropWhile (<=2015) conFactorizacionesCapicuas)

-- 2023

Desemparejamiento de listas

PorJosé A. Alonso 23-diciembre-201430-diciembre-2014

Definir la función

   desemparejada :: [(a,b)] -> ([a],[b])

1	desemparejada :: [(a,b)] -> ([a],[b])

tal que (desemparejada ps) es el par de lista (xs,ys) tal que al emparejar (con zip) xs e ys devuelve ps. Por ejemplo,

   ghci> desemparejada [(3,'l'),(2,'u'),(5,'i'),(9,'s')]
   ([3,2,5,9],"luis")

1 2	ghci> desemparejada [(3,'l'),(2,'u'),(5,'i'),(9,'s')] ([3,2,5,9],"luis")

Comprobar con QuickCheck que

desemparejada es equivalente a la función predefinida unzip.
si el valor de (desemparejada ps) es (xs,ys), entonces (zip xs ys) es igual a ps.

Soluciones

import Test.QuickCheck

-- 1ª definición (por comprensión):
desemparejada1 :: [(a,b)] -> ([a],[b])
desemparejada1 ps = ([x | (x,_) <- ps], [y | (_,y) <- ps])

-- 2ª definición (con map):
desemparejada2 :: [(a,b)] -> ([a],[b])
desemparejada2 ps = (map fst ps, map snd ps)

-- 3ª definición (por recursión):
desemparejada3 :: [(a,b)] -> ([a],[b])
desemparejada3 []         = ([],[])
desemparejada3 ((x,y):ps) = (x:xs,y:ys)
    where (xs,ys) = desemparejada3 ps 

-- 4ª definición (por plegado):
desemparejada4 :: [(a,b)] -> ([a],[b])
desemparejada4 = foldr f ([],[])
    where f (x,y) (xs,ys) = (x:xs, y:ys)

-- 5ª definición (por plegado por la izquierda):
desemparejada5 :: [(a,b)] -> ([a],[b])
desemparejada5 ps = (reverse us, reverse vs)
    where (us,vs) = foldl f ([],[]) ps
          f (xs,ys) (x,y) = (x:xs,y:ys)

-- Comparación de eficiencia-
--    ghci> let ps = zip [1..10^7] [1..10^7]
--    
--    ghci> length (fst (desemparejada1 ps))
--    10000000
--    (3.67 secs, 360441524 bytes)
--    
--    ghci> length (fst (desemparejada2 ps))
--    10000000
--    (0.38 secs, 440476764 bytes)
--    
--    ghci> length (fst (desemparejada3 ps))
--    10000000
--    (14.11 secs, 2160188668 bytes)
--    
--    ghci> length (fst (desemparejada4 ps))
--    10000000
--    (19.08 secs, 1658689692 bytes)
--    
--    ghci> length (fst (desemparejada5 ps))
--    10000000
--    (20.98 secs, 1610061796 bytes)

-- En lo que sigue, usaremos la  2º definición
desemparejada :: [(a,b)] -> ([a],[b])
desemparejada = desemparejada2

-- La primera propiedad es
prop_desemparejada_1 :: (Eq a, Eq b) => [(a,b)] -> Bool
prop_desemparejada_1 ps =
    desemparejada ps == unzip ps

-- Su comprobación es
--    ghci> quickCheck prop_desemparejada_1
--    +++ OK, passed 100 tests.

-- La segunda propiedad es
prop_desemparejada_2 :: (Eq a, Eq b) => [(a,b)] -> Bool
prop_desemparejada_2 ps = zip xs ys == ps
    where (xs,ys) = desemparejada ps

-- Su comprobación es
--    ghci> quickCheck prop_desemparejada_2
--    +++ OK, passed 100 tests.

import Test.QuickCheck

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

desemparejada1 :: [(a,b)] -> ([a],[b])

desemparejada1 ps = ([x | (x,_) <- ps], [y | (_,y) <- ps])

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

desemparejada2 :: [(a,b)] -> ([a],[b])

desemparejada2 ps = (map fst ps, map snd ps)

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

desemparejada3 :: [(a,b)] -> ([a],[b])

desemparejada3 [] = ([],[])

desemparejada3 ((x,y):ps) = (x:xs,y:ys)

where (xs,ys) = desemparejada3 ps

-- 4ª definición (por plegado):

desemparejada4 :: [(a,b)] -> ([a],[b])

desemparejada4 = foldr f ([],[])

where f (x,y) (xs,ys) = (x:xs, y:ys)

-- 5ª definición (por plegado por la izquierda):

desemparejada5 :: [(a,b)] -> ([a],[b])

desemparejada5 ps = (reverse us, reverse vs)

where (us,vs) = foldl f ([],[]) ps

f (xs,ys) (x,y) = (x:xs,y:ys)

-- Comparación de eficiencia-

-- ghci> let ps = zip [1..10^7] [1..10^7]

-- ghci> length (fst (desemparejada1 ps))

-- 10000000

-- (3.67 secs, 360441524 bytes)

-- ghci> length (fst (desemparejada2 ps))

-- 10000000

-- (0.38 secs, 440476764 bytes)

-- ghci> length (fst (desemparejada3 ps))

-- 10000000

-- (14.11 secs, 2160188668 bytes)

-- ghci> length (fst (desemparejada4 ps))

-- 10000000

-- (19.08 secs, 1658689692 bytes)

-- ghci> length (fst (desemparejada5 ps))

-- 10000000

-- (20.98 secs, 1610061796 bytes)

-- En lo que sigue, usaremos la 2º definición

desemparejada :: [(a,b)] -> ([a],[b])

desemparejada = desemparejada2

-- La primera propiedad es

prop_desemparejada_1 :: (Eq a, Eq b) => [(a,b)] -> Bool

prop_desemparejada_1 ps =

desemparejada ps == unzip ps

-- Su comprobación es

-- ghci> quickCheck prop_desemparejada_1

-- +++ OK, passed 100 tests.

-- La segunda propiedad es

prop_desemparejada_2 :: (Eq a, Eq b) => [(a,b)] -> Bool

prop_desemparejada_2 ps = zip xs ys == ps

where (xs,ys) = desemparejada ps

-- Su comprobación es

-- ghci> quickCheck prop_desemparejada_2

-- +++ OK, passed 100 tests.

2015, suma de dígitos y número de divisores

PorJosé A. Alonso 22-diciembre-20141-mayo-2016

Una propiedad del 2015 es que la suma de sus dígitos coincide con el número de sus divisores; en efecto, la suma de sus dígitos es 2+0+1+5=8 y tiene 8 divisores (1, 5, 13, 31, 65, 155, 403 y 2015).

Definir la sucesión

   especiales :: [Int]

1	especiales :: [Int]

formada por los números n tales que la suma de los dígitos de n coincide con el número de divisores de n. Por ejemplo,

   take 12 especiales == [1,2,11,22,36,84,101,152,156,170,202,208]

1	take 12 especiales == [1,2,11,22,36,84,101,152,156,170,202,208]

Usar la sucesión para responder las siguientes cuestiones

¿Cuántos años hasta el 2015 inclusive han cumplido la propiedad?
¿Cuál fue el anterior al 2015 que cumplió la propiedad?
¿Cuál será el siguiente al 2015 que cumplirá la propiedad?

Nota: La sucesión especiales es la misma que la A057531 de la OEIS (On-Line Encyclopedia of Integer Sequences).

Soluciones

especiales :: [Int]
especiales = [n | n <- [1..], especial n]

especial :: Int -> Bool
especial n = sum (digitos n) == length (divisores n)

digitos :: Int -> [Int]
digitos n = [read [d] | d <- show n]

divisores :: Int -> [Int]
divisores n = [x | x <- [1..n], n `mod` x == 0]

-- El cálculo de número de años hasta el 2015 inclusive que han cumplido
-- la propiedad es
--    ghci> length (takeWhile (<=2015) especiales)
--    59

-- El cálculo del anterior al 2015 que cumplió la propiedad es
--    ghci> last (takeWhile (<2015) especiales)
--    2006

-- El cálculo del siguiente al 2015 que cumplirá la propiedad es 
--    ghci> head (dropWhile (<=2015) especiales)
--    2101

especiales :: [Int]

especiales = [n | n <- [1..], especial n]

especial :: Int -> Bool

especial n = sum (digitos n) == length (divisores n)

digitos :: Int -> [Int]

digitos n = [read [d] | d <- show n]

divisores :: Int -> [Int]

divisores n = [x | x <- [1..n], n `mod` x == 0]

-- El cálculo de número de años hasta el 2015 inclusive que han cumplido

-- la propiedad es

-- ghci> length (takeWhile (<=2015) especiales)

-- 59

-- El cálculo del anterior al 2015 que cumplió la propiedad es

-- ghci> last (takeWhile (<2015) especiales)

-- 2006

-- El cálculo del siguiente al 2015 que cumplirá la propiedad es

-- ghci> head (dropWhile (<=2015) especiales)

-- 2101

2015 como raíz cuadrada de la suma de tres cubos

PorJosé A. Alonso 19-diciembre-20141-mayo-2016

Todos los años, en las proximidades del final de año suelen aparecer cuestiones con propiedades del número del nuevo año. Una sobre el 2015 es la publicada el martes en la entrada 2015 como raíz de la suma de tres cubos del blog Números y algo más en la que se pide calcular tres números tales que 2015 sea igual a la raíz cuadrada de la suma de dichos tres números.

A partir de dicha entrada, se propone el siguiente problema: Definir la sucesión

   raicesCuadradasDeSumasDe3Cubos :: [Integer]

1	raicesCuadradasDeSumasDe3Cubos :: [Integer]

cuyos elementos son los números que se pueden escribir como raíces cuadradas de sumas de tres cubos. Por ejemplo,

   take 9 raicesCuadradasDeSumasDe3Cubos = [6,9,15,27,48,72,53,59,78]

1	take 9 raicesCuadradasDeSumasDe3Cubos = [6,9,15,27,48,72,53,59,78]

El 6 está en la sucesión porque 1³+2³+3³ = 36 y la raíz cuadrada de36 es 6 y el 9 está porque 3³+3³+3³ = 81 y la raíz cuadrada de 81 es 9. Algunos números tienen varias descomposiones como raíz cuadrada de suma de tres cubos; por ejemplo, el 71 se puede escribir como la raíz cuadrada de la suma de los cubos de 6, 9 y 16 y también como la de 4, 4, y 17.

A partir de la sucesión se plantean las siguientes cuestiones:

¿Qué lugar ocupa el 2015 en la sucesión?
¿Cuál será el próximo año que se podrá escribir como la raíz cuadrada de suma de tres cubos?
¿Cuáles son las descomposiciones de 2015 como raíz cuadrada de suma de tres cubos?
¿Cuáles son los años hasta el 2015 que se pueden escribir como raíz cuadrada de suma de tres cubos de más formas distintas?

Soluciones

import Data.List (sort)

raicesCuadradasDeSumasDe3Cubos :: [Integer]
raicesCuadradasDeSumasDe3Cubos =
    [n | n <- [1..], not (null (descomposiciones n))]

-- (descomposiciones n) es la lista de ternas de números tales que n es la
-- raíz cuadrada de la suma de los cubos de los tres números de la
-- terna. Por ejemplo,
--    descomposiciones  6  ==  [(1,2,3)]
--    descomposiciones  9  ==  [(3,3,3)]
--    descomposiciones 71  ==  [(6,9,16),(4,4,17)]
descomposiciones :: Integer -> [(Integer,Integer,Integer)]
descomposiciones n = 
    [(a,b,c) | c <- [1..floor ((fromIntegral (n*n))**(1/3))],
               b <- [1..c],
               let d = n^2 - c^3 - b^3,
               d > 0,
               let a = round ((fromIntegral d)**(1/3)),
               a <= b,
               a^3 == d]    

-- El cálculo de la posición de 2015 es
--    ghci> length (takeWhile (<=2015) raicesCuadradasDeSumasDe3Cubos)
--    343

-- El cálculo del próximo año expresable como la raízcuadrada de la suma
-- de tres cubos es
--    ghci> head (dropWhile (<=2015) raicesCuadradasDeSumasDe3Cubos)
--    2022

-- (masDescomponibles xs) es la lista de elementos de xs que se pueden
-- escribir de más formas como raíz cuadrada de suma de tres cubos.
masDescomponibles :: [Integer] -> [Integer]
masDescomponibles xs =
    [y | (x,y) <- takeWhile (\p -> fst p == u) zs]
    where zs = reverse (sort [(length (descomposiciones x),x) | x <- xs])
          u  = fst (head zs)

-- El cálculo de los años hasta el 2015 con mayor número de
-- descomposiciones es
--    ghci> masDescomponibles (takeWhile (<=2015) raicesCuadradasDeSumasDe3Cubos)
--    [1728]

import Data.List (sort)

raicesCuadradasDeSumasDe3Cubos :: [Integer]

raicesCuadradasDeSumasDe3Cubos =

[n | n <- [1..], not (null (descomposiciones n))]

-- (descomposiciones n) es la lista de ternas de números tales que n es la

-- raíz cuadrada de la suma de los cubos de los tres números de la

-- terna. Por ejemplo,

-- descomposiciones 6 == [(1,2,3)]

-- descomposiciones 9 == [(3,3,3)]

-- descomposiciones 71 == [(6,9,16),(4,4,17)]

descomposiciones :: Integer -> [(Integer,Integer,Integer)]

descomposiciones n =

[(a,b,c) | c <- [1..floor ((fromIntegral (n*n))**(1/3))],

b <- [1..c],

let d = n^2 - c^3 - b^3,

d > 0,

let a = round ((fromIntegral d)**(1/3)),

a <= b,

a^3 == d]

-- El cálculo de la posición de 2015 es

-- ghci> length (takeWhile (<=2015) raicesCuadradasDeSumasDe3Cubos)

-- 343

-- El cálculo del próximo año expresable como la raízcuadrada de la suma

-- de tres cubos es

-- ghci> head (dropWhile (<=2015) raicesCuadradasDeSumasDe3Cubos)

-- 2022

-- (masDescomponibles xs) es la lista de elementos de xs que se pueden

-- escribir de más formas como raíz cuadrada de suma de tres cubos.

masDescomponibles :: [Integer] -> [Integer]

masDescomponibles xs =

[y | (x,y) <- takeWhile (\p -> fst p == u) zs]

where zs = reverse (sort [(length (descomposiciones x),x) | x <- xs])

u = fst (head zs)

-- El cálculo de los años hasta el 2015 con mayor número de

-- descomposiciones es

-- ghci> masDescomponibles (takeWhile (<=2015) raicesCuadradasDeSumasDe3Cubos)

-- [1728]

Elementos adicionales

PorJosé A. Alonso 17-diciembre-201427-diciembre-2014

Enunciado

-- Definir la función
--    adicionales :: Ord a => Int -> [a] -> [a] -> [a]
-- tal que (adicionales n xs ys) es la lista de los n elementos de xs
-- que no pertenecen a ys (se supone que las listas xs e ys están
-- ordenadas y que pueden ser infinitas). Por ejemplo, 
--    adicionales 0 [1,3]   [1,3]                  ==  []
--    adicionales 1 [1,3]   [1]                    ==  [3]
--    adicionales 2 [1,3,5] [1]                    ==  [3,5]
--    adicionales 2 [1,3,5,7,9] [1,5,7]            ==  [3,9]
--    adicionales 2 ([1,3,5]++[7..]) ([1]++[7..])  ==  [3,5]

-- Definir la función

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

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

-- que no pertenecen a ys (se supone que las listas xs e ys están

-- ordenadas y que pueden ser infinitas). Por ejemplo,

-- adicionales 0 [1,3] [1,3] == []

-- adicionales 1 [1,3] [1] == [3]

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

-- adicionales 2 [1,3,5,7,9] [1,5,7] == [3,9]

-- adicionales 2 ([1,3,5]++[7..]) ([1]++[7..]) == [3,5]

Soluciones

-- 1ª definición (por recursión)
adicionales1 :: Ord a => Int -> [a] -> [a] -> [a]
adicionales1 0 _  _  = []
adicionales1 _ xs [] = xs
adicionales1 n (x:xs) (y:ys) 
    | x <  y    = x : adicionales1 (n-1) xs (y:ys)
    | x == y    = adicionales1 n xs ys
    | otherwise = adicionales1 n (x:xs) ys

-- 2ª definición (por comprensión):
adicionales2 :: Ord a => Int -> [a] -> [a] -> [a]
adicionales2 n xs ys =
    take n [x | x <- xs, x `noPertenece` ys]

-- (noPertenece x ys) se verifica si x no pertenece a la lista ordenada 
-- (posiblemente infinita ys). Por ejemplo.
--    noPertenece 2 [3,5]    ==  True
--    noPertenece 4 [3,5]    ==  True
--    noPertenece 7 [3,5]    ==  True
--    noPertenece 4 [3,5..]  ==  True
noPertenece :: Ord a => a -> [a] -> Bool
noPertenece x ys = null zs || head zs /= x
    where zs = dropWhile (<x) ys

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

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

adicionales1 0 _ _ = []

adicionales1 _ xs [] = xs

adicionales1 n (x:xs) (y:ys)

| x < y = x : adicionales1 (n-1) xs (y:ys)

| x == y = adicionales1 n xs ys

| otherwise = adicionales1 n (x:xs) ys

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

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

adicionales2 n xs ys =

take n [x | x <- xs, x `noPertenece` ys]

-- (noPertenece x ys) se verifica si x no pertenece a la lista ordenada

-- (posiblemente infinita ys). Por ejemplo.

-- noPertenece 2 [3,5] == True

-- noPertenece 4 [3,5] == True

-- noPertenece 7 [3,5] == True

-- noPertenece 4 [3,5..] == True

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

noPertenece x ys = null zs || head zs /= x

where zs = dropWhile (<x) ys

Números que sumados a su siguiente primo dan primos

PorJosé A. Alonso 11-diciembre-201425-marzo-2022

Introducción

La Enciclopedia electrónica de sucesiones de enteros (OEIS por sus siglas en inglés, de On-Line Encyclopedia of Integer Sequences) es una base de datos que registra sucesiones de números enteros. Está disponible libremente en Internet, en la dirección http://oeis.org.

La semana pasada Antonio Roldán añadió una nueva sucesión a la OEIS, la A249624 que sirve de base para el problema de hoy.

Enunciado

-- Definir la sucesión
--     a249624 :: [Integer]
-- tal que sus elementos son los números x tales que la suma de x y el
-- primo que le sigue es un número primo. Por ejemplo, 
--    ghci> take 20 a249624
--    [0,1,2,6,8,14,18,20,24,30,34,36,38,48,50,54,64,68,78,80]
-- 
-- El número 8 está en la sucesión porque su siguiente primo es 11 y
-- 8+11=19 es primo. El 12 no está en la sucesión porque su siguiente
-- primo es 13 y 12+13=25 no es primo.

-- Definir la sucesión

-- a249624 :: [Integer]

-- tal que sus elementos son los números x tales que la suma de x y el

-- primo que le sigue es un número primo. Por ejemplo,

-- ghci> take 20 a249624

-- [0,1,2,6,8,14,18,20,24,30,34,36,38,48,50,54,64,68,78,80]

-- El número 8 está en la sucesión porque su siguiente primo es 11 y

-- 8+11=19 es primo. El 12 no está en la sucesión porque su siguiente

-- primo es 13 y 12+13=25 no es primo.

Soluciones

import Data.Numbers.Primes (primes, isPrime)
import Data.List (genericReplicate)

-- 1ª definición
-- =============

a249624 :: [Integer]
a249624 = 0: 1: [x | x <- [2,4..], primo (x + siguientePrimo x)]

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

siguientePrimo :: Integer -> Integer
siguientePrimo x = head [y | y <- [x+1..], primo y]

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

a249624b :: [Integer]
a249624b = 0 : 1 : 2: aux [2,4..] primos where
    aux (x:xs) (y:ys) 
        | y < x                = aux (x:xs) ys
        | (x+y) `pertenece` ys = x : aux xs (y:ys)
        | otherwise            = aux xs (y:ys)
    pertenece x ys = x == head (dropWhile (<x) ys)

primos :: [Integer]
primos = 2 : [x | x <- [3,5..], primo x]

-- 3ª definición (con la librería de primos)
-- =========================================

a249624c :: [Integer]
a249624c = 0: 1: [x | x <- [2,4..], isPrime (x + siguientePrimo3 x)]

siguientePrimo3 x = head [y | y <- [x+1..], isPrime y]

-- 4ª definición (por recursión con la librería de primos)
-- =======================================================

a249624d :: [Integer]
a249624d = 0 : 1 : 2: aux [2,4..] primes where
    aux (x:xs) (y:ys) 
        | y < x                = aux (x:xs) ys
        | (x+y) `pertenece` ys = x : aux xs (y:ys)
        | otherwise            = aux xs (y:ys)
    pertenece x ys = x == head (dropWhile (<x) ys)

-- 5ª definición
-- =============

a249624e :: [Integer]
a249624e = [a | q <- primes, 
                let p = siguientePrimo3 (q `div` 2),
                let a = q-p,
                siguientePrimo3 a == p]

-- 6ª definición
-- =============

a249624f :: [Integer]
a249624f = [x | (x,y) <- zip [0..] ps, isPrime (x+y)]
    where ps = 2:2:concat (zipWith f primes (tail primes))
          f p q = genericReplicate (q-p) q

-- 7ª definición
-- =============

a249624g :: [Integer]
a249624g = 0:1:(aux primes (tail primes) primes)
    where aux (x:xs) (y:ys) zs
              | null rs   = aux xs ys zs2
              | otherwise = [r-y | r <- rs] ++ (aux xs ys zs2)
              where a = x+y
                    b = 2*y-1
                    zs1 = takeWhile (<=b) zs
                    rs = [r | r <- [a..b], r `elem` zs1]
                    zs2 = dropWhile (<=b) zs

-- ---------------------------------------------------------------------
-- § Comparación de eficiencia                                        --
-- ---------------------------------------------------------------------

-- La comparación es
--    ghci> :set +s
--    
--    ghci> a249624 !! 700
--    5670
--    (12.72 secs, 1245938184 bytes)
--    
--    ghci> a249624b !! 700
--    5670
--    (8.01 secs, 764775268 bytes)
-- 
--    ghci> a249624c !! 700
--    5670
--    (0.22 secs, 108982640 bytes)
--    
--    ghci> a249624d !! 700
--    5670
--    (0.20 secs, 4707384 bytes)
--    
--    ghci> a249624e !! 700
--    5670
--    (0.17 secs, 77283064 bytes)
--    
--    ghci> a249624f !! 700
--    5670
--    (0.08 secs, 31684408 bytes)
--    
--    ghci> a249624g !! 700
--    5670
--    (0.03 secs, 4651576 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

import Data.Numbers.Primes (primes, isPrime)

import Data.List (genericReplicate)

-- 1ª definición

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

a249624 :: [Integer]

a249624 = 0: 1: [x | x <- [2,4..], primo (x + siguientePrimo x)]

primo :: Integer -> Bool

primo x = [y | y <- [1..x], x `rem` y == 0] == [1,x]

siguientePrimo :: Integer -> Integer

siguientePrimo x = head [y | y <- [x+1..], primo y]

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

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

a249624b :: [Integer]

a249624b = 0 : 1 : 2: aux [2,4..] primos where

aux (x:xs) (y:ys)

| y < x = aux (x:xs) ys

| (x+y) `pertenece` ys = x : aux xs (y:ys)

| otherwise = aux xs (y:ys)

pertenece x ys = x == head (dropWhile (<x) ys)

primos :: [Integer]

primos = 2 : [x | x <- [3,5..], primo x]

-- 3ª definición (con la librería de primos)

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

a249624c :: [Integer]

a249624c = 0: 1: [x | x <- [2,4..], isPrime (x + siguientePrimo3 x)]

siguientePrimo3 x = head [y | y <- [x+1..], isPrime y]

-- 4ª definición (por recursión con la librería de primos)

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

a249624d :: [Integer]

a249624d = 0 : 1 : 2: aux [2,4..] primes where

aux (x:xs) (y:ys)

| y < x = aux (x:xs) ys

| (x+y) `pertenece` ys = x : aux xs (y:ys)

| otherwise = aux xs (y:ys)

pertenece x ys = x == head (dropWhile (<x) ys)

-- 5ª definición

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

a249624e :: [Integer]

a249624e = [a | q <- primes,

let p = siguientePrimo3 (q `div` 2),

let a = q-p,

siguientePrimo3 a == p]

-- 6ª definición

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

a249624f :: [Integer]

a249624f = [x | (x,y) <- zip [0..] ps, isPrime (x+y)]

where ps = 2:2:concat (zipWith f primes (tail primes))

f p q = genericReplicate (q-p) q

-- 7ª definición

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

a249624g :: [Integer]

a249624g = 0:1:(aux primes (tail primes) primes)

where aux (x:xs) (y:ys) zs

| null rs = aux xs ys zs2

| otherwise = [r-y | r <- rs] ++ (aux xs ys zs2)

where a = x+y

b = 2*y-1

zs1 = takeWhile (<=b) zs

rs = [r | r <- [a..b], r `elem` zs1]

zs2 = dropWhile (<=b) zs

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

-- § Comparación de eficiencia --

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

-- La comparación es

-- ghci> :set +s

-- ghci> a249624 !! 700

-- 5670

-- (12.72 secs, 1245938184 bytes)

-- ghci> a249624b !! 700

-- 5670

-- (8.01 secs, 764775268 bytes)

-- ghci> a249624c !! 700

-- 5670

-- (0.22 secs, 108982640 bytes)

-- ghci> a249624d !! 700

-- 5670

-- (0.20 secs, 4707384 bytes)

-- ghci> a249624e !! 700

-- 5670

-- (0.17 secs, 77283064 bytes)

-- ghci> a249624f !! 700

-- 5670

-- (0.08 secs, 31684408 bytes)

-- ghci> a249624g !! 700

-- 5670

-- (0.03 secs, 4651576 bytes)

Problema de las puertas

PorJosé A. Alonso 5-diciembre-201425-abril-2021

Enunciado

-- Un hotel dispone de n habitaciones y n camareros. Los camareros
-- tienen la costumbre de cambiar de estado las puestas (es decir,
-- abrir las cerradas y cerrar las abiertas). El proceso es el
-- siguiente: 
--    * Inicialmente todas las puertas están cerradas. 
--    * El primer camarero cambia de estado las puertas de todas las
--      habitaciones. 
--    * El segundo cambia de estado de las puertas de las habitaciones
--      pares. 
--    * El tercero cambia de estado todas las puertas que son
--      múltiplos de 3. 
--    * El cuarto cambia de estado todas las puertas que son múltiplos
--      de 4 
--    * Así hasta que ha pasado el último camarero.
-- Por ejemplo, para n = 5
--    Pase    | Puerta 1 | Puerta 2 | Puerta 3 | Puerta 4 | Puerta 5
--    --------+----------+----------+----------+----------+---------
--    Inicial | Cerrada  | Cerrada  | Cerrada  | Cerrada  | Cerrada
--    Pase 1  | Abierta  | Abierta  | Abierta  | Abierta  | Abierta
--    Pase 2  | Abierta  | Cerrada  | Abierta  | Cerrada  | Abierta
--    Pase 3  | Abierta  | Cerrada  | Cerrada  | Cerrada  | Abierta
--    Pase 4  | Abierta  | Cerrada  | Cerrada  | Abierta  | Abierta
--    Pase 5  | Abierta  | Cerrada  | Cerrada  | Abierta  | Cerrada 
-- 
-- Los estados de las puertas se representan por el siguiente tipo de
-- datos 
--    data Estado = Abierta | Cerrada deriving Show
-- 
-- Definir la función
--    final :: Int -> [Estado]
-- tal que (final n) es la lista de los estados de las n puertas después
-- de que hayan pasado los n camareros. Por
-- ejemplo,
--    ghci> final 5
--    [Abierta,Cerrada,Cerrada,Abierta,Cerrada]
--    ghci> final 7
--    [Abierta,Cerrada,Cerrada,Abierta,Cerrada,Cerrada,Cerrada]

-- Un hotel dispone de n habitaciones y n camareros. Los camareros

-- tienen la costumbre de cambiar de estado las puestas (es decir,

-- abrir las cerradas y cerrar las abiertas). El proceso es el

-- siguiente:

-- * Inicialmente todas las puertas están cerradas.

-- * El primer camarero cambia de estado las puertas de todas las

-- habitaciones.

-- * El segundo cambia de estado de las puertas de las habitaciones

-- pares.

-- * El tercero cambia de estado todas las puertas que son

-- múltiplos de 3.

-- * El cuarto cambia de estado todas las puertas que son múltiplos

-- de 4

-- * Así hasta que ha pasado el último camarero.

-- Por ejemplo, para n = 5

-- --------+----------+----------+----------+----------+---------

-- Los estados de las puertas se representan por el siguiente tipo de

-- datos

-- data Estado = Abierta | Cerrada deriving Show

-- Definir la función

-- final :: Int -> [Estado]

-- tal que (final n) es la lista de los estados de las n puertas después

-- de que hayan pasado los n camareros. Por

-- ejemplo,

-- ghci> final 5

-- [Abierta,Cerrada,Cerrada,Abierta,Cerrada]

-- ghci> final 7

-- [Abierta,Cerrada,Cerrada,Abierta,Cerrada,Cerrada,Cerrada]

Soluciones

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

data Estado = Abierta | Cerrada 
              deriving (Eq, Show)
 
cambia Abierta = Cerrada
cambia Cerrada = Abierta

-- (inicial n) es el estado inicial para el problema de las n
-- habitaciones. Por ejemplo,
--    inicial 5  ==  [Cerrada,Cerrada,Cerrada,Cerrada,Cerrada]
inicial :: Int -> [Estado]
inicial n = replicate n Cerrada

-- (pase k es) es la lista de los estados de las puertas después de pasar el
-- camarero k que las encuentra en los estados es. Por ejemplo,
--    ghci> pase 1 (inicial 5)
--    [Abierta,Abierta,Abierta,Abierta,Abierta]
--    ghci> pase 2 it
--    [Abierta,Cerrada,Abierta,Cerrada,Abierta]
--    ghci> pase 3 it
--    [Abierta,Cerrada,Cerrada,Cerrada,Abierta]
--    ghci> pase 4 it
--    [Abierta,Cerrada,Cerrada,Abierta,Abierta]
--    ghci> pase 5 it
--    [Abierta,Cerrada,Cerrada,Abierta,Cerrada]
pase :: [Estado] -> Int -> [Estado] 
pase es k = zipWith cambiaK  es[1..] 
  where cambiaK e n | n `mod` k == 0 = cambia e
                    | otherwise      = e
               
final :: Int -> [Estado]
final n = aux [1..n] (inicial n) 
    where aux []     es = es  
          aux (k:ks) es = aux ks (pase es k)

-- 2ª solución (con foldl')
-- ========================

final2 :: Int -> [Estado]
final2 n = foldl pase (inicial n) [1..n] 

-- 3ª definición (basada en los cambios de cada posición)
-- ======================================================

final3 :: Int -> [Estado]
final3 n = map f [1..n]
    where f x | even (length (divisores x)) = Cerrada
              | otherwise                   = Abierta

divisores :: Int -> [Int]
divisores n = [x| x <- [1..n], n `mod` x == 0]

-- 4ª definición (basada en posiciones de abiertas)
-- ================================================

-- En primer lugar, vamos a determinar la lista de las posiciones
-- (comenzando a contar en 1) de las puertas que quedan abierta en el
-- problema de las n puertas. 
posicionesAbiertas :: Int -> [Int]
posicionesAbiertas n = 
    [x | (x,y) <- zip [1..] (final n), y == Abierta]

-- Al calcularlas,
--    ghci> posicionesAbiertas 200
--    [1,4,9,16,25,36,49,64,81,100,121,144,169,196]
-- Se observa las que quedan abiertas son las que sus posiciones son
-- cuadrados perfectos. Usando esta observación se construye la
-- siguiente definición

final4 :: Int -> [Estado]
final4 n = aux [1..n] [k*k | k <- [1..]] 
    where aux (x:xs) (y:ys) | x == y  =  Abierta : aux xs ys
          aux (x:xs) ys               =  Cerrada : aux xs ys
          aux []     _                =  []

-- 1ª solución

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

data Estado = Abierta | Cerrada

deriving (Eq, Show)

cambia Abierta = Cerrada

cambia Cerrada = Abierta

-- (inicial n) es el estado inicial para el problema de las n

-- habitaciones. Por ejemplo,

-- inicial 5 == [Cerrada,Cerrada,Cerrada,Cerrada,Cerrada]

inicial :: Int -> [Estado]

inicial n = replicate n Cerrada

-- (pase k es) es la lista de los estados de las puertas después de pasar el

-- camarero k que las encuentra en los estados es. Por ejemplo,

-- ghci> pase 1 (inicial 5)

-- [Abierta,Abierta,Abierta,Abierta,Abierta]

-- ghci> pase 2 it

-- [Abierta,Cerrada,Abierta,Cerrada,Abierta]

-- ghci> pase 3 it

-- [Abierta,Cerrada,Cerrada,Cerrada,Abierta]

-- ghci> pase 4 it

-- [Abierta,Cerrada,Cerrada,Abierta,Abierta]

-- ghci> pase 5 it

-- [Abierta,Cerrada,Cerrada,Abierta,Cerrada]

pase :: [Estado] -> Int -> [Estado]

pase es k = zipWith cambiaK es[1..]

where cambiaK e n | n `mod` k == 0 = cambia e

| otherwise = e

final :: Int -> [Estado]

final n = aux [1..n] (inicial n)

where aux [] es = es

aux (k:ks) es = aux ks (pase es k)

-- 2ª solución (con foldl')

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

final2 :: Int -> [Estado]

final2 n = foldl pase (inicial n) [1..n]

-- 3ª definición (basada en los cambios de cada posición)

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

final3 :: Int -> [Estado]

final3 n = map f [1..n]

where f x | even (length (divisores x)) = Cerrada

| otherwise = Abierta

divisores :: Int -> [Int]

divisores n = [x| x <- [1..n], n `mod` x == 0]

-- 4ª definición (basada en posiciones de abiertas)

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

-- En primer lugar, vamos a determinar la lista de las posiciones

-- (comenzando a contar en 1) de las puertas que quedan abierta en el

-- problema de las n puertas.

posicionesAbiertas :: Int -> [Int]

posicionesAbiertas n =

[x | (x,y) <- zip [1..] (final n), y == Abierta]

-- Al calcularlas,

-- ghci> posicionesAbiertas 200

-- [1,4,9,16,25,36,49,64,81,100,121,144,169,196]

-- Se observa las que quedan abiertas son las que sus posiciones son

-- cuadrados perfectos. Usando esta observación se construye la

-- siguiente definición

final4 :: Int -> [Estado]

final4 n = aux [1..n] [k*k | k <- [1..]]

where aux (x:xs) (y:ys) | x == y = Abierta : aux xs ys

aux (x:xs) ys = Cerrada : aux xs ys

aux [] _ = []

Llanuras de longitud dada

PorJosé A. Alonso 4-diciembre-20141-mayo-2016

Enunciado

-- Una llanura de longitud n de una lista xs es una sublista de xs
-- formada por n elementos iguales.
--
-- Definir la función
--    llanuras :: Eq a => Int -> [a] -> [[a]]
-- tal que (llanuras n xs) es la lista de las llanuras de xs que tienen
-- n elementos como mínimo. Por ejemplo,
--    llanuras 3 "aabbbcddddffxffxx"  ==  ["bbb","dddd"]

-- Una llanura de longitud n de una lista xs es una sublista de xs

-- formada por n elementos iguales.

-- Definir la función

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

-- tal que (llanuras n xs) es la lista de las llanuras de xs que tienen

-- n elementos como mínimo. Por ejemplo,

-- llanuras 3 "aabbbcddddffxffxx" == ["bbb","dddd"]

Soluciones

import Data.List (group)
import Test.QuickCheck

-- 1ª definición (por comprensión):
llanuras :: Eq a => Int -> [a] -> [[a]]
llanuras n xs = [ys | ys <- group xs, length ys >= n] 

-- 2ª definición (por recursión con takeWhile y dropWhile):
llanuras2 :: Eq a => Int -> [a] -> [[a]]
llanuras2 _ [] = []
llanuras2 n xs@(x:_) 
    | length ys >= n = ys : llanuras2 n (dropWhile (x==) xs) 
    | otherwise      = llanuras2 n (dropWhile (x==) xs) 
    where ys = takeWhile (x==) xs

-- 3ª definición (por recursión con span):
llanuras3 :: Eq a => Int -> [a] -> [[a]]
llanuras3 _ [] = []
llanuras3 n xs@(x:_) 
    | length ys >= n = ys : llanuras3 n zs
    | otherwise      = llanuras3 n zs
    where (ys,zs) = span (x==) xs

-- 4ª definición (por recursión con span):
llanuras4 :: Eq a => Int -> [a] -> [[a]]
llanuras4 n = aux where
    aux [] = []
    aux xs@(x:_) | length ys >= n = ys : llanuras4 n zs
                 | otherwise      = llanuras4 n zs
                 where (ys,zs) = span (x==) xs

-- ---------------------------------------------------------------------
-- § Verificación                                                     --
-- ---------------------------------------------------------------------

-- Las definiciones son equivalentes
prop_equivalencia :: Int -> [Int] -> Bool
prop_equivalencia n xs =
    llanuras2 n xs == ys &&
    llanuras3 n xs == ys
    where ys = llanuras n xs

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

import Data.List (group)

import Test.QuickCheck

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

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

llanuras n xs = [ys | ys <- group xs, length ys >= n]

-- 2ª definición (por recursión con takeWhile y dropWhile):

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

llanuras2 _ [] = []

llanuras2 n xs@(x:_)

| length ys >= n = ys : llanuras2 n (dropWhile (x==) xs)

| otherwise = llanuras2 n (dropWhile (x==) xs)

where ys = takeWhile (x==) xs

-- 3ª definición (por recursión con span):

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

llanuras3 _ [] = []

llanuras3 n xs@(x:_)

| length ys >= n = ys : llanuras3 n zs

| otherwise = llanuras3 n zs

where (ys,zs) = span (x==) xs

-- 4ª definición (por recursión con span):

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

llanuras4 n = aux where

aux [] = []

aux xs@(x:_) | length ys >= n = ys : llanuras4 n zs

| otherwise = llanuras4 n zs

where (ys,zs) = span (x==) xs

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

-- § Verificación --

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

-- Las definiciones son equivalentes

prop_equivalencia :: Int -> [Int] -> Bool

prop_equivalencia n xs =

llanuras2 n xs == ys &&

llanuras3 n xs == ys

where ys = llanuras n xs

-- La comprobación es

-- ghci> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

Referencias

Esté ejercicio está basado en el problema Llanura de números iguales con longitud igual a n propuesto Solveet!

Aplicaciones alternativas

PorJosé A. Alonso 26-noviembre-201425-marzo-2022

Enunciado

-- Definir la función
--    alternativa :: (a -> b) -> (a -> b) -> [a] -> [b]
-- tal que (alternativa f g xs) es la lista obtenida aplicando
-- alternativamente las funciones f y g a los elementos de xs. Por
-- ejemplo, 
--    alternativa (+1)  (+10) [1,2,3,4]    ==  [2,12,4,14]
--    alternativa (+10) (*10) [1,2,3,4,5]  ==  [11,20,13,40,15]

-- Definir la función

-- alternativa :: (a -> b) -> (a -> b) -> [a] -> [b]

-- tal que (alternativa f g xs) es la lista obtenida aplicando

-- alternativamente las funciones f y g a los elementos de xs. Por

-- ejemplo,

-- alternativa (+1) (+10) [1,2,3,4] == [2,12,4,14]

-- alternativa (+10) (*10) [1,2,3,4,5] == [11,20,13,40,15]

Soluciones

[schedule expon=’2014-12-03′ expat=»06:00″]

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

[/schedule]

[schedule on=’2014-12-03′ at=»06:00″]

-- 1ª definición (por recursión):
alternativa1 :: (a -> b) -> (a -> b) -> [a] -> [b]
alternativa1 f g []     = []
alternativa1 f g (x:xs) = f x : alternativa1 g f xs

-- 2ª definición (por comprensión):
alternativa2 :: (a -> b) -> (a -> b) -> [a] -> [b]
alternativa2 f g xs = 
    [h x | (h,x) <- zip (cycle [f,g]) xs]

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

alternativa1 :: (a -> b) -> (a -> b) -> [a] -> [b]

alternativa1 f g [] = []

alternativa1 f g (x:xs) = f x : alternativa1 g f xs

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

alternativa2 :: (a -> b) -> (a -> b) -> [a] -> [b]

alternativa2 f g xs =

[h x | (h,x) <- zip (cycle [f,g]) xs]

[/schedule]

Cuantificadores sobre listas

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

Enunciado

-- Definir la función 
--    verificaP :: (a -> Bool) -> [[a]] -> Bool
-- tal que (verificaP p xs) se verifica si cada elemento de la lista xss
-- contiene algún elemento que cumple el predicado p. Por ejemplo,
--    verificaP odd [[1,3,4,2], [4,5], [9]] == True
--    verificaP odd [[1,3,4,2], [4,8], [9]] == False

-- Definir la función

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

-- tal que (verificaP p xs) se verifica si cada elemento de la lista xss

-- contiene algún elemento que cumple el predicado p. Por ejemplo,

-- verificaP odd [[1,3,4,2], [4,5], [9]] == True

-- verificaP odd [[1,3,4,2], [4,8], [9]] == False

Soluciones

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

Las soluciones se pueden escribir en los comentarios hasta el 28 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-28′ at=»06:00″]

-- 1ª definición (por comprensión):
verificaP :: (a -> Bool) -> [[a]] -> Bool
verificaP p xss = and [any p xs | xs <- xss]

-- 2ª definición (por recursión):
verificaP2 :: (a -> Bool) -> [[a]] -> Bool
verificaP2 p []       = True
verificaP2 p (xs:xss) = any p xs && verificaP2 p xss

-- 3ª definición (por plegado):
verificaP3 :: (a -> Bool) -> [[a]] -> Bool
verificaP3 p = foldr ((&&) . any p) True

-- 4ª definición (con cuantificadores)
verificaP4 :: (a -> Bool) -> [[a]] -> Bool
verificaP4 p = all (any p)

-- 5ª definición (con cuantificadores y composición)
verificaP5 :: (a -> Bool) -> [[a]] -> Bool
verificaP5 = all . any

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

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

verificaP p xss = and [any p xs | xs <- xss]

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

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

verificaP2 p [] = True

verificaP2 p (xs:xss) = any p xs && verificaP2 p xss

-- 3ª definición (por plegado):

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

verificaP3 p = foldr ((&&) . any p) True

-- 4ª definición (con cuantificadores)

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

verificaP4 p = all (any p)

-- 5ª definición (con cuantificadores y composición)

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

verificaP5 = all . any

[/schedule]

Mayores elementos de una matriz

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

Enunciado

-- Las matrices se pueden representar mediante listas de listas. Por
-- ejemplo, la matriz
--    |3 2 5|
--    |4 9 7|
-- se puede representar por [[3,2,5],[4,9,7]].
-- 
-- Definir la función
--    mayores :: Ord a => Int -> [[a]] -> [(a,Int)]
-- tal que (mayores n xss) es la lista de los n mayores elementos de la
-- matriz xss junto con sus correspondientes número de fila. Por
-- ejemplo,
--    ghci> mayores 4 [[4,26,9],[2,37,53],[41,1,8]]
--    [(53,2),(41,3),(37,2),(26,1)]
-- 
-- Comprobar con QuickCheck que todos los elementos de (mayores n xss)
-- son mayores o iguales que los restantes elementos de xss.
-- 
-- Nota: Se pueden usar las funciones sort y (\\) de la librería
-- Data.List.

-- Las matrices se pueden representar mediante listas de listas. Por

-- ejemplo, la matriz

-- |3 2 5|

-- |4 9 7|

-- se puede representar por [[3,2,5],[4,9,7]].

-- Definir la función

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

-- tal que (mayores n xss) es la lista de los n mayores elementos de la

-- matriz xss junto con sus correspondientes número de fila. Por

-- ejemplo,

-- ghci> mayores 4 [[4,26,9],[2,37,53],[41,1,8]]

-- [(53,2),(41,3),(37,2),(26,1)]

-- Comprobar con QuickCheck que todos los elementos de (mayores n xss)

-- son mayores o iguales que los restantes elementos de xss.

-- Nota: Se pueden usar las funciones sort y (\\) de la librería

-- Data.List.

Soluciones

import Data.List (sort, (\\))
import Test.QuickCheck

-- 1ª solución (con auxiliares)
-- ============================

mayores1 :: Ord a => Int -> [[a]] -> [(a,Int)]
mayores1 n xss = take n (reverse (sort (enumeracion xss)))

-- (enumeracion xss) es la lista de los elementos de xs junto con el
-- número de su fila. Por ejemplo,
--    ghci> enumeracion [[4,26,9],[2,37,53],[41,1,8]]
--    [(4,1),(26,1),(9,1),(2,2),(37,2),(53,2),(41,3),(1,3),(8,3)]
enumeracion :: [[a]] -> [(a,Int)]
enumeracion xss =
    [(x,i) | (xs,i) <- enumeracionFilas xss, x <- xs]

-- (enumeracionFilas xss) es la lista de las filas de xs junto con su
-- número. Por ejemplo,
--    ghci> enumeracionFilas [[4,26,9],[2,37,53],[41,1,8]]
--    [([4,26,9],1),([2,37,53],2),([41,1,8],3)]
enumeracionFilas :: [[a]] -> [([a],Int)]
enumeracionFilas xss = zip xss [1..]

-- 2ª solución (sin auxiliares)
-- ============================

mayores2 :: Ord a => Int -> [[a]] -> [(a,Int)]
mayores2 n xss = 
    take n (reverse (sort [(x,i) | (xs,i) <- zip xss [1..], x <- xs]))

-- Comprobaciones
-- ==============

-- Las dos definiciones son equivalentes
prop_equivalencia :: Int -> [[Int]] -> Bool
prop_equivalencia n xss =
    mayores1 n xss == mayores2 n xss

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

-- La propiedad de mayores es
prop_mayores :: Int -> [[Int]] -> Bool
prop_mayores n xss =
    and [x <= y | x <- elementos \\ elementosMayores, y <- elementosMayores]
    where elementos = concat xss
          elementosMayores = [x | (x,_) <- mayores1 n xss]

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

-- Otra forma de expresa la propiedad es
prop_mayores2 :: Int -> [[Int]] -> Bool
prop_mayores2 n xss = 
    all (\x -> all (<=x) elementosRestantes) elementosMayores
    where elementosMayores   = map fst (mayores1 n xss)
          elementosRestantes = concat xss \\ elementosMayores

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

import Data.List (sort, (\\))

import Test.QuickCheck

-- 1ª solución (con auxiliares)

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

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

mayores1 n xss = take n (reverse (sort (enumeracion xss)))

-- (enumeracion xss) es la lista de los elementos de xs junto con el

-- número de su fila. Por ejemplo,

-- ghci> enumeracion [[4,26,9],[2,37,53],[41,1,8]]

-- [(4,1),(26,1),(9,1),(2,2),(37,2),(53,2),(41,3),(1,3),(8,3)]

enumeracion :: [[a]] -> [(a,Int)]

enumeracion xss =

[(x,i) | (xs,i) <- enumeracionFilas xss, x <- xs]

-- (enumeracionFilas xss) es la lista de las filas de xs junto con su

-- número. Por ejemplo,

-- ghci> enumeracionFilas [[4,26,9],[2,37,53],[41,1,8]]

-- [([4,26,9],1),([2,37,53],2),([41,1,8],3)]

enumeracionFilas :: [[a]] -> [([a],Int)]

enumeracionFilas xss = zip xss [1..]

-- 2ª solución (sin auxiliares)

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

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

mayores2 n xss =

take n (reverse (sort [(x,i) | (xs,i) <- zip xss [1..], x <- xs]))

-- Comprobaciones

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

-- Las dos definiciones son equivalentes

prop_equivalencia :: Int -> [[Int]] -> Bool

prop_equivalencia n xss =

mayores1 n xss == mayores2 n xss

-- La comprobación es

-- ghci> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

-- La propiedad de mayores es

prop_mayores :: Int -> [[Int]] -> Bool

prop_mayores n xss =

and [x <= y | x <- elementos \\ elementosMayores, y <- elementosMayores]

where elementos = concat xss

elementosMayores = [x | (x,_) <- mayores1 n xss]

-- La comprobación es

-- ghci> quickCheck prop_mayores

-- +++ OK, passed 100 tests.

-- Otra forma de expresa la propiedad es

prop_mayores2 :: Int -> [[Int]] -> Bool

prop_mayores2 n xss =

all (\x -> all (<=x) elementosRestantes) elementosMayores

where elementosMayores = map fst (mayores1 n xss)

elementosRestantes = concat xss \\ elementosMayores

-- La comprobación es

-- ghci> quickCheck prop_mayores2

-- +++ OK, passed 100 tests.

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

Repetición de elementos

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

Enunciado

-- Definir la función
--    repiteElementos :: Int -> [a] -> [a]
-- tal que (repiteElementos k xs) es la lista obtenida repitiendo cada
-- elemento de xs k veces. Por ejemplo,
--    repiteElementos 3 [5,2,7,4]  ==  [5,5,5,2,2,2,7,7,7,4,4,4]
--
-- Comprobar con QuickCheck que, para todo número natural k y toda lista
-- xs, el número de elementos de (repiteElementos k xs) es k veces el
-- número de elementos de xs.
--
-- Nota. Al hacer la comprobación limitar el tamaño de las pruebas como
-- se indica a continuación
--    ghci> quickCheckWith (stdArgs {maxSize=7}) prop_repiteElementos
--    +++ OK, passed 100 tests.

-- Definir la función

-- repiteElementos :: Int -> [a] -> [a]

-- tal que (repiteElementos k xs) es la lista obtenida repitiendo cada

-- elemento de xs k veces. Por ejemplo,

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

-- Comprobar con QuickCheck que, para todo número natural k y toda lista

-- xs, el número de elementos de (repiteElementos k xs) es k veces el

-- número de elementos de xs.

-- Nota. Al hacer la comprobación limitar el tamaño de las pruebas como

-- se indica a continuación

-- ghci> quickCheckWith (stdArgs {maxSize=7}) prop_repiteElementos

-- +++ OK, passed 100 tests.

Soluciones

import Test.QuickCheck

-- 1ª definición (por comprensión):
repiteElementos1 :: Int -> [a] -> [a]
repiteElementos1 k xs = concat [replicate k x | x <- xs]

-- 2ª definición (con map)
repiteElementos2 :: Int -> [a] -> [a]
repiteElementos2 k xs = concat (map (replicate k) xs)

-- 3ª definición (con concatMap):
repiteElementos3 :: Int -> [a] -> [a]
repiteElementos3 k = concatMap (replicate k)

-- 4ª definición (por recursión):
repiteElementos4 :: Int -> [a] -> [a]
repiteElementos4 k [] = []
repiteElementos4 k (x:xs) = replicate k x ++ repiteElementos4 k xs

-- 5ª definición (por plegado):
repiteElementos5 :: Int -> [a] -> [a]
repiteElementos5 k = foldr ((++) . replicate k) []

-- Propiedad de equivalencia
prop_equivalencia :: Int -> [Int] -> Bool
prop_equivalencia k xs =
    repiteElementos2 k xs == ys &&
    repiteElementos3 k xs == ys &&
    repiteElementos4 k xs == ys &&
    repiteElementos5 k xs == ys 
    where ys = repiteElementos1 k xs

-- Su comprobación es
--    ghci> quickCheckWith (stdArgs {maxSize=10}) prop_equivalencia
--    +++ OK, passed 100 tests.

-- La propiedad es
prop_repiteElementos :: Int -> [Int] -> Property
prop_repiteElementos k xs =
    k >= 0 ==> length (repiteElementos1 k xs) == k * length xs 

-- La comprobación es
--    ghci> quickCheckWith (stdArgs {maxSize=7}) prop_repiteElementos
--    +++ OK, passed 100 tests.

import Test.QuickCheck

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

repiteElementos1 :: Int -> [a] -> [a]

repiteElementos1 k xs = concat [replicate k x | x <- xs]

-- 2ª definición (con map)

repiteElementos2 :: Int -> [a] -> [a]

repiteElementos2 k xs = concat (map (replicate k) xs)

-- 3ª definición (con concatMap):

repiteElementos3 :: Int -> [a] -> [a]

repiteElementos3 k = concatMap (replicate k)

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

repiteElementos4 :: Int -> [a] -> [a]

repiteElementos4 k [] = []

repiteElementos4 k (x:xs) = replicate k x ++ repiteElementos4 k xs

-- 5ª definición (por plegado):

repiteElementos5 :: Int -> [a] -> [a]

repiteElementos5 k = foldr ((++) . replicate k) []

-- Propiedad de equivalencia

prop_equivalencia :: Int -> [Int] -> Bool

prop_equivalencia k xs =

repiteElementos2 k xs == ys &&

repiteElementos3 k xs == ys &&

repiteElementos4 k xs == ys &&

repiteElementos5 k xs == ys

where ys = repiteElementos1 k xs

-- Su comprobación es

-- ghci> quickCheckWith (stdArgs {maxSize=10}) prop_equivalencia

-- +++ OK, passed 100 tests.

-- La propiedad es

prop_repiteElementos :: Int -> [Int] -> Property

prop_repiteElementos k xs =

k >= 0 ==> length (repiteElementos1 k xs) == k * length xs

-- La comprobación es

-- ghci> quickCheckWith (stdArgs {maxSize=7}) prop_repiteElementos

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

Código Morse

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

El código Morse es un sistema de representación de letras y números mediante señales emitidas de forma intermitente.

A los signos (letras mayúsculas o dígitos) se le asigna un código como se muestra a continuación

    +---+-------+---+-------+---+-------+---+-------+
    | A | .-    | J | .---  | S | ...   | 1 | ..--- |
    | B | -...  | K | -.-   | T | -     | 2 | ...-- |
    | C | -.-.  | L | .-..  | U | ..-   | 3 | ....- |
    | D | -..   | M | --    | V | ...-  | 4 | ..... |
    | E | .     | N | -.    | W | .--   | 5 | -.... |
    | F | ..-.  | O | ---   | X | -..-  | 6 | --... |
    | G | --.   | P | .--.  | Y | -.--  | 7 | ---.. |
    | H | ....  | Q | --.-  | Z | --..  | 8 | ----. |
    | I | ..    | R | .-.   | 0 | .---- | 9 | ----- |
    +---+-------+---+-------+---+-------+---+-------+

+---+-------+---+-------+---+-------+---+-------+

| A | .- | J | .--- | S | ... | 1 | ..--- |

| B | -... | K | -.- | T | - | 2 | ...-- |

| C | -.-. | L | .-.. | U | ..- | 3 | ....- |

| D | -.. | M | -- | V | ...- | 4 | ..... |

| E | . | N | -. | W | .-- | 5 | -.... |

| F | ..-. | O | --- | X | -..- | 6 | --... |

| G | --. | P | .--. | Y | -.-- | 7 | ---.. |

| H | .... | Q | --.- | Z | --.. | 8 | ----. |

| I | .. | R | .-. | 0 | .---- | 9 | ----- |

+---+-------+---+-------+---+-------+---+-------+

El código Morse de las palabras se obtiene a partir del de sus caracteres insertando un espacio entre cada uno. Por ejemplo, el código de "todo" es "- --- -.. ---"

El código Morse de las frases se obtiene a partir del de sus palabras insertando dos espacios entre cada uno. Por ejemplo, el código de "todo o nada" es "- --- -.. --- --- -. .- -.. .-"

Enunciado

-- Definir las funciones
--    fraseAmorse :: String -> String
--    morseAfrase :: String -> String
-- tales que
-- * (fraseAmorse cs) es la traducción de la frase cs a Morse. Por
--   ejemplo, 
--      ghci> fraseAmorse "En todo la medida"
--      ". -.  - --- -.. ---  .-.. .-  -- . -.. .. -.. .-"
-- * (morseAfrase cs) es la frase cuya traducción a Morse es cs. Por 
--   ejemplo, 
--      ghci> morseAfrase ". -.  - --- -.. ---  .-.. .-  -- . -.. .. -.. .-"
--      "EN TODO LA MEDIDA"
--
-- Nota: La lista de los códigos Morse de A, B, ..., Z, 0, 1, ..., 9 es
--    [".-","-...","-.-.","-..",".","..-.","--.","....","..",".---",
--     "-.-",".-..","--","-.","---",".--.","--.-",".-.","...","-",
--     "..-","...-",".--","-..-","-.--","--..",".----","..---","...--",
--     "....-",".....","-....","--...","---..","----.","-----"]

-- Definir las funciones

-- fraseAmorse :: String -> String

-- morseAfrase :: String -> String

-- tales que

-- * (fraseAmorse cs) es la traducción de la frase cs a Morse. Por

-- ejemplo,

-- ghci> fraseAmorse "En todo la medida"

-- ". -. - --- -.. --- .-.. .- -- . -.. .. -.. .-"

-- * (morseAfrase cs) es la frase cuya traducción a Morse es cs. Por

-- ejemplo,

-- ghci> morseAfrase ". -. - --- -.. --- .-.. .- -- . -.. .. -.. .-"

-- "EN TODO LA MEDIDA"

-- Nota: La lista de los códigos Morse de A, B, ..., Z, 0, 1, ..., 9 es

-- [".-","-...","-.-.","-..",".","..-.","--.","....","..",".---",

-- "-.-",".-..","--","-.","---",".--.","--.-",".-.","...","-",

-- "..-","...-",".--","-..-","-.--","--..",".----","..---","...--",

-- "....-",".....","-....","--...","---..","----.","-----"]

Ayuda: Se puede usar la función splitOn de la librería Data.List.Split.

Soluciones

import Data.Char (toUpper)
import Data.List (intercalate)
import Data.List.Split (splitOn)

-- caracteres es la lista ordenada de las caracteres (letras mayúsculas
-- y dígitos) que se usan en los mensajes Morse.
caracteres :: [Char]
caracteres = ['A'..'Z'] ++ ['0'..'9']

-- morse es la lista de los códigos Morse correspondientes a la lista
-- de caracteres.
morse :: [String]
morse = [".-","-...","-.-.","-..",".","..-.","--.","....","..",".---",
         "-.-",".-..","--","-.","---",".--.","--.-",".-.","...","-",
         "..-","...-",".--","-..-","-.--","--..",".----","..---","...--",
         "....-",".....","-....","--...","---..","----.","-----"]

-- (correspondiente xs ys x) es el elemento de ys en la misma posición
-- que x en xs. Por ejemplo,
--    correspondiente [1..10] [2,4..20] 3  ==  6
correspondiente :: Ord a => [a] -> [b] -> a -> b
correspondiente xs ys x = head [y | (z,y) <- zip xs ys, z == x]

-- (caracterAmorse x) es el código Morse correspondiente al carácter
-- x. Por ejemplo, 
--    caracterAmorse 'A'  ==  ".-"
--    caracterAmorse 'B'  ==  "-..."
--    caracterAmorse '1'  ==  "..---"
--    caracterAmorse 'a'  ==  ".-"
caracterAmorse :: Char -> String
caracterAmorse = correspondiente caracteres morse . toUpper

-- (morseAcaracter x) es el carácter cuyo código Morse es x. Por
-- ejemplo,  
--    morseAcaracter ".-"     ==  'A'
--    morseAcaracter "-..."   ==  'B'
--    morseAcaracter "..---"  ==  '1'
morseAcaracter :: String -> Char
morseAcaracter = correspondiente morse caracteres

-- (palabraAmorse cs) es el código Morse correspondiente a la palabra
-- cs. Por ejemplo,
--    palabraAmorse "En"  ==  ". -."
palabraAmorse :: [Char] -> String
palabraAmorse = unwords . map caracterAmorse

-- (morseApalabra cs) es la palabra cuyo traducción a Morse es cs. Por
-- ejemplo, 
--    morseApalabra ". -."  ==  "EN"
morseApalabra :: String -> [Char]
morseApalabra = map morseAcaracter . words

-- (fraseAmorse cs) es la traducción de la frase cs a Morse. Por ejemplo,
--    ghci> fraseAmorse "En todo la medida"
--    ". -.  - --- -.. ---  .-.. .-  -- . -.. .. -.. .-"
fraseAmorse :: String -> String
fraseAmorse = intercalate "  " . map palabraAmorse . words

-- Ejemplo de cálculo
--    fraseAmorse "En todo la medida"
--    = (intercalate "  " . map palabraAmorse . words)
--      "En todo la medida"
--    = (intercalate "  " . map palabraAmorse)
--      ["En","todo","la","medida"]
--    = intercalate "  " [". -.","- --- -.. ---",".-.. .-","-- . -.. .. -.. .-"]
--    = ". -.  - --- -.. ---  .-.. .-  -- . -.. .. -.. .-"
  
-- (morseAfrase cs) es la frase cuya traducción a Morse es cs. Por
-- ejemplo, 
--    ghci> morseAfrase ". -.  - --- -.. ---  .-.. .-  -- . -.. .. -.. .-"
--    "EN TODO LA MEDIDA"
morseAfrase :: String -> String
morseAfrase = unwords . map morseApalabra . splitOn "  "

-- Ejemplo de cálculo
--    morseAfrase ". -.  - --- -.. ---  .-.. .-  -- . -.. .. -.. .-"
--    = (unwords . map morseApalabra)
--      ". -.  - --- -.. ---  .-.. .-  -- . -.. .. -.. .-"
--    = (unwords . map morseApalabra)
--      [". -.","- --- -.. ---",".-.. .-","-- . -.. .. -.. .-"]
--    = unwords ["EN","TODO","LA","MEDIDA"]
--    = "EN TODO LA MEDIDA"

import Data.Char (toUpper)

import Data.List (intercalate)

import Data.List.Split (splitOn)

-- caracteres es la lista ordenada de las caracteres (letras mayúsculas

-- y dígitos) que se usan en los mensajes Morse.

caracteres :: [Char]

caracteres = ['A'..'Z'] ++ ['0'..'9']

-- morse es la lista de los códigos Morse correspondientes a la lista

-- de caracteres.

morse :: [String]

morse = [".-","-...","-.-.","-..",".","..-.","--.","....","..",".---",

"-.-",".-..","--","-.","---",".--.","--.-",".-.","...","-",

"..-","...-",".--","-..-","-.--","--..",".----","..---","...--",

"....-",".....","-....","--...","---..","----.","-----"]

-- (correspondiente xs ys x) es el elemento de ys en la misma posición

-- que x en xs. Por ejemplo,

-- correspondiente [1..10] [2,4..20] 3 == 6

correspondiente :: Ord a => [a] -> [b] -> a -> b

correspondiente xs ys x = head [y | (z,y) <- zip xs ys, z == x]

-- (caracterAmorse x) es el código Morse correspondiente al carácter

-- x. Por ejemplo,

-- caracterAmorse 'A' == ".-"

-- caracterAmorse 'B' == "-..."

-- caracterAmorse '1' == "..---"

-- caracterAmorse 'a' == ".-"

caracterAmorse :: Char -> String

caracterAmorse = correspondiente caracteres morse . toUpper

-- (morseAcaracter x) es el carácter cuyo código Morse es x. Por

-- ejemplo,

-- morseAcaracter ".-" == 'A'

-- morseAcaracter "-..." == 'B'

-- morseAcaracter "..---" == '1'

morseAcaracter :: String -> Char

morseAcaracter = correspondiente morse caracteres

-- (palabraAmorse cs) es el código Morse correspondiente a la palabra

-- cs. Por ejemplo,

-- palabraAmorse "En" == ". -."

palabraAmorse :: [Char] -> String

palabraAmorse = unwords . map caracterAmorse

-- (morseApalabra cs) es la palabra cuyo traducción a Morse es cs. Por

-- ejemplo,

-- morseApalabra ". -." == "EN"

morseApalabra :: String -> [Char]

morseApalabra = map morseAcaracter . words

-- (fraseAmorse cs) es la traducción de la frase cs a Morse. Por ejemplo,

-- ghci> fraseAmorse "En todo la medida"

-- ". -. - --- -.. --- .-.. .- -- . -.. .. -.. .-"

fraseAmorse :: String -> String

fraseAmorse = intercalate " " . map palabraAmorse . words

-- Ejemplo de cálculo

-- fraseAmorse "En todo la medida"

-- = (intercalate " " . map palabraAmorse . words)

-- "En todo la medida"

-- = (intercalate " " . map palabraAmorse)

-- ["En","todo","la","medida"]

-- = intercalate " " [". -.","- --- -.. ---",".-.. .-","-- . -.. .. -.. .-"]

-- = ". -. - --- -.. --- .-.. .- -- . -.. .. -.. .-"

-- (morseAfrase cs) es la frase cuya traducción a Morse es cs. Por

-- ejemplo,

-- ghci> morseAfrase ". -. - --- -.. --- .-.. .- -- . -.. .. -.. .-"

-- "EN TODO LA MEDIDA"

morseAfrase :: String -> String

morseAfrase = unwords . map morseApalabra . splitOn " "

-- Ejemplo de cálculo

-- morseAfrase ". -. - --- -.. --- .-.. .- -- . -.. .. -.. .-"

-- = (unwords . map morseApalabra)

-- ". -. - --- -.. --- .-.. .- -- . -.. .. -.. .-"

-- = (unwords . map morseApalabra)

-- [". -.","- --- -.. ---",".-.. .-","-- . -.. .. -.. .-"]

-- = unwords ["EN","TODO","LA","MEDIDA"]

-- = "EN TODO LA MEDIDA"

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.

Empiezan con mayúscula

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

Enunciado

-- Ejercicio. Definir, por composición, la función
--    conMayuscula :: String -> Int
-- tal que (conMayuscula cs) es el número de palabras de cs que empiezan
-- con mayúscula. Por ejemplo.
--    conMayuscula "Juan vive en Sevilla o en Huelva"  ==  3

-- Ejercicio. Definir, por composición, la función

-- conMayuscula :: String -> Int

-- tal que (conMayuscula cs) es el número de palabras de cs que empiezan

-- con mayúscula. Por ejemplo.

-- conMayuscula "Juan vive en Sevilla o en Huelva" == 3

Soluciones

import Data.Char

conMayuscula :: String -> Int
conMayuscula = length . filter (isUpper . head) . words

import Data.Char

conMayuscula :: String -> Int

conMayuscula = length . filter (isUpper . head) . words

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]

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

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.

Buscaminas

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

Enunciado

-- El buscaminas es un juego cuyo objetivo es despejar un campo de minas
-- sin detonar ninguna. 
-- 
-- El campo de minas se representa mediante un cuadrado con NxN
-- casillas. Algunas casillas tienen un número, este número indica las
-- minas que hay en todas las casillas vecinas. Cada casilla tiene como
-- máximo 8 vecinas. Por ejemplo, el campo 4x4 de la izquierda
-- contiene dos minas, cada una representada por el número 9, y a la 
-- derecha se muestra el campo obtenido anotando las minas vecinas de
-- cada casilla
--    9 0 0 0       9 1 0 0
--    0 0 0 0       2 2 1 0
--    0 9 0 0       1 9 1 0
--    0 0 0 0       1 1 1 0
-- de la misma forma, la anotación del siguiente a la izquierda es el de
-- la derecha 
--    9 9 0 0 0     9 9 1 0 0
--    0 0 0 0 0     3 3 2 0 0
--    0 9 0 0 0     1 9 1 0 0
--
-- En el ejercicio se usará la librería Data.Matrix, cuyo manual se encuentra
-- en http://bit.ly/1hWVNJD
-- 
-- Los campos de minas se representan mediante matrices: 
--    type Campo = Matrix Int
-- Por ejemplo, los anteriores campos de la izquierda se definen por
--    ejCampo1, ejCampo2 :: Campo
--    ejCampo1 = fromLists [[9,0,0,0],
--                          [0,0,0,0], 
--                          [0,9,0,0], 
--                          [0,0,0,0]]
--    ejCampo2 = fromLists [[9,9,0,0,0],
--                          [0,0,0,0,0],
--                          [0,9,0,0,0]]
-- 
-- Definir la función
--    buscaminas :: Campo -> Campo
-- tal que (buscaminas c) es el campo obtenido anotando las minas
-- vecinas de cada casilla. Por ejemplo,
--    ghci> buscaminas ejCampo1
--    ( 9 1 0 0 )
--    ( 2 2 1 0 )
--    ( 1 9 1 0 )
--    ( 1 1 1 0 )
--
--    ghci> buscaminas ejCampo2
--    ( 9 9 1 0 0 )
--    ( 3 3 2 0 0 )
--    ( 1 9 1 0 0 )
-- 
-- Nota. Las funciones de la librería de matrices útiles para este ejercicio
-- son fromLists, matrix, nrows y ncols.

-- El buscaminas es un juego cuyo objetivo es despejar un campo de minas

-- sin detonar ninguna.

-- El campo de minas se representa mediante un cuadrado con NxN

-- casillas. Algunas casillas tienen un número, este número indica las

-- minas que hay en todas las casillas vecinas. Cada casilla tiene como

-- máximo 8 vecinas. Por ejemplo, el campo 4x4 de la izquierda

-- contiene dos minas, cada una representada por el número 9, y a la

-- derecha se muestra el campo obtenido anotando las minas vecinas de

-- cada casilla

-- 9 0 0 0 9 1 0 0

-- 0 0 0 0 2 2 1 0

-- 0 9 0 0 1 9 1 0

-- 0 0 0 0 1 1 1 0

-- de la misma forma, la anotación del siguiente a la izquierda es el de

-- la derecha

-- 9 9 0 0 0 9 9 1 0 0

-- 0 0 0 0 0 3 3 2 0 0

-- 0 9 0 0 0 1 9 1 0 0

-- En el ejercicio se usará la librería Data.Matrix, cuyo manual se encuentra

-- en http://bit.ly/1hWVNJD

-- Los campos de minas se representan mediante matrices:

-- type Campo = Matrix Int

-- Por ejemplo, los anteriores campos de la izquierda se definen por

-- ejCampo1, ejCampo2 :: Campo

-- ejCampo1 = fromLists [[9,0,0,0],

-- [0,0,0,0],

-- [0,9,0,0],

-- [0,0,0,0]]

-- ejCampo2 = fromLists [[9,9,0,0,0],

-- [0,0,0,0,0],

-- [0,9,0,0,0]]

-- Definir la función

-- buscaminas :: Campo -> Campo

-- tal que (buscaminas c) es el campo obtenido anotando las minas

-- vecinas de cada casilla. Por ejemplo,

-- ghci> buscaminas ejCampo1

-- ( 9 1 0 0 )

-- ( 2 2 1 0 )

-- ( 1 9 1 0 )

-- ( 1 1 1 0 )

-- ghci> buscaminas ejCampo2

-- ( 9 9 1 0 0 )

-- ( 3 3 2 0 0 )

-- ( 1 9 1 0 0 )

-- Nota. Las funciones de la librería de matrices útiles para este ejercicio

-- son fromLists, matrix, nrows y ncols.

Soluciones

import Data.Matrix

type Campo   = Matrix Int
type Casilla = (Int,Int)

ejCampo1, ejCampo2 :: Campo
ejCampo1 = fromLists [[9,0,0,0],
                      [0,0,0,0], 
                      [0,9,0,0], 
                      [0,0,0,0]]
ejCampo2 = fromLists [[9,9,0,0,0],
                      [0,0,0,0,0],
                      [0,9,0,0,0]]

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

buscaminas1 :: Campo -> Campo
buscaminas1 c = matrix m n (\(i,j) -> minas c (i,j))
    where m = nrows c
          n = ncols c

-- (minas c (i,j)) es el número de minas en las casillas vecinas de la
-- (i,j) en el campo de mina c y es 9 si en (i,j) hay una mina. Por
-- ejemplo,
--    minas ejCampo (1,1)  ==  9
--    minas ejCampo (1,2)  ==  1
--    minas ejCampo (1,3)  ==  0
--    minas ejCampo (2,1)  ==  2
minas :: Campo -> Casilla -> Int
minas c (i,j) 
    | c!(i,j) == 9 = 9
    | otherwise    = length (filter (==9) [c!(x,y) | (x,y) <- vecinas m n (i,j)])
                     where m = nrows c
                           n = ncols c

-- (vecinas m n (i,j)) es la lista de las casillas vecinas de la (i,j) en
-- un campo de dimensiones mxn. Por ejemplo,
--    vecinas 4 (1,1)  ==  [(1,2),(2,1),(2,2)]
--    vecinas 4 (1,2)  ==  [(1,1),(1,3),(2,1),(2,2),(2,3)]
--    vecinas 4 (2,3)  ==  [(1,2),(1,3),(1,4),(2,2),(2,4),(3,2),(3,3),(3,4)]
vecinas :: Int -> Int -> Casilla -> [Casilla]
vecinas m n (i,j) = [(a,b) | a <- [max 1 (i-1)..min m (i+1)],
                             b <- [max 1 (j-1)..min n (j+1)],
                             (a,b) /= (i,j)]

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

buscaminas2 :: Campo -> Campo
buscaminas2 c = matrix m n (\(i,j) -> minas (i,j))
    where m = nrows c
          n = ncols c
          minas :: Casilla -> Int
          minas (i,j) 
              | c!(i,j) == 9 = 9
              | otherwise    = 
                  length (filter (==9) [c!(x,y) | (x,y) <- vecinas (i,j)])
          vecinas :: Casilla -> [Casilla]
          vecinas (i,j) = [(a,b) | a <- [max 1 (i-1)..min m (i+1)],
                                   b <- [max 1 (j-1)..min n (j+1)],
                                   (a,b) /= (i,j)]

import Data.Matrix

type Campo = Matrix Int

type Casilla = (Int,Int)

ejCampo1, ejCampo2 :: Campo

ejCampo1 = fromLists [[9,0,0,0],

[0,0,0,0],

[0,9,0,0],

[0,0,0,0]]

ejCampo2 = fromLists [[9,9,0,0,0],

[0,0,0,0,0],

[0,9,0,0,0]]

-- 1ª solución

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

buscaminas1 :: Campo -> Campo

buscaminas1 c = matrix m n (\(i,j) -> minas c (i,j))

where m = nrows c

n = ncols c

-- (minas c (i,j)) es el número de minas en las casillas vecinas de la

-- (i,j) en el campo de mina c y es 9 si en (i,j) hay una mina. Por

-- ejemplo,

-- minas ejCampo (1,1) == 9

-- minas ejCampo (1,2) == 1

-- minas ejCampo (1,3) == 0

-- minas ejCampo (2,1) == 2

minas :: Campo -> Casilla -> Int

minas c (i,j)

| c!(i,j) == 9 = 9

| otherwise = length (filter (==9) [c!(x,y) | (x,y) <- vecinas m n (i,j)])

where m = nrows c

n = ncols c

-- (vecinas m n (i,j)) es la lista de las casillas vecinas de la (i,j) en

-- un campo de dimensiones mxn. Por ejemplo,

-- vecinas 4 (1,1) == [(1,2),(2,1),(2,2)]

-- vecinas 4 (1,2) == [(1,1),(1,3),(2,1),(2,2),(2,3)]

-- vecinas 4 (2,3) == [(1,2),(1,3),(1,4),(2,2),(2,4),(3,2),(3,3),(3,4)]

vecinas :: Int -> Int -> Casilla -> [Casilla]

vecinas m n (i,j) = [(a,b) | a <- [max 1 (i-1)..min m (i+1)],

b <- [max 1 (j-1)..min n (j+1)],

(a,b) /= (i,j)]

-- 2ª solución

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

buscaminas2 :: Campo -> Campo

buscaminas2 c = matrix m n (\(i,j) -> minas (i,j))

where m = nrows c

n = ncols c

minas :: Casilla -> Int

minas (i,j)

| c!(i,j) == 9 = 9

| otherwise =

length (filter (==9) [c!(x,y) | (x,y) <- vecinas (i,j)])

vecinas :: Casilla -> [Casilla]

vecinas (i,j) = [(a,b) | a <- [max 1 (i-1)..min m (i+1)],

b <- [max 1 (j-1)..min n (j+1)],

(a,b) /= (i,j)]

Referencia

El ejercicio está basado en Minesweeper 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.

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

Soluciones

Soluciones

Soluciones

Soluciones

Enunciado

Soluciones

Introducción

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Referencias

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Soluciones

Referencia

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Referencia

Enunciado

Soluciones

Referencia

Enunciado

Soluciones

Referencia

Enunciado

Soluciones

Entradas recientes

Buscar

Correo electrónico