map – Página 8 – Exercitium

Primos hereditarios

PorJosé A. Alonso 16-abril-20151-mayo-2016

Un número primo es hereditario si todos los números obtenidos eliminando dígitos por la derecha o por la izquierda son primos. Por ejemplo, 3797 es hereditario ya que los números obtenidos eliminando dígitos por la derecha son 3797, 379, 37 y 3 y los obtenidos eliminando dígitos por la izquierda son 3797, 797, 97 y 7 y todos ellos son primos.

Definir la sucesión

   hereditarios :: [Integer]

1	hereditarios :: [Integer]

cuyos elementos son los números hereditarios. Por ejemplo,

   ghci> take 15 hereditarios
   [2,3,5,7,23,37,53,73,313,317,373,797,3137,3797,739397]

1 2	ghci> take 15 hereditarios [2,3,5,7,23,37,53,73,313,317,373,797,3137,3797,739397]

Soluciones

import Data.List (inits, tails)
import Data.Char (digitToInt)
import Data.Numbers.Primes (primes, isPrime)

hereditarios :: [Integer]
hereditarios = [n | n <- primes, hereditario n]

hereditario :: Integer -> Bool
hereditario n = 
    all odd (map digitToInt (tail ds)) &&
    all isPrime (map read (tail (inits ds))) &&
    all isPrime (map read (init (tails ds)))
    where ds = show n

import Data.List (inits, tails)

import Data.Char (digitToInt)

import Data.Numbers.Primes (primes, isPrime)

hereditarios :: [Integer]

hereditarios = [n | n <- primes, hereditario n]

hereditario :: Integer -> Bool

hereditario n =

all odd (map digitToInt (tail ds)) &&

all isPrime (map read (tail (inits ds))) &&

all isPrime (map read (init (tails ds)))

where ds = show n

Constante de Champernowne

PorJosé A. Alonso 15-abril-201525-marzo-2022

La constante de Champernowne es el número irracional

   0.12345678910111213141516171819202122232425262728293031323334 ...

1	0.12345678910111213141516171819202122232425262728293031323334 ...

cuya parte entera es 0 y la parte decimal se obtiene concatenado los números naturales a partir de 1.

Definir la función

   productoChampernowne :: [Int] -> Int

1	productoChampernowne :: [Int] -> Int

tal que (productoChampernowne ns) es el producto de los dígitos de la constante de Champernowne que ocupan las posiciones ns. Por ejemplo,

   productoChampernowne [0,1,2]                 ==  6
   productoChampernowne [8,20]                  ==  45
   productoChampernowne [10^i-1 | i <- [0..7]]  ==  1470

productoChampernowne [0,1,2] == 6

productoChampernowne [8,20] == 45

productoChampernowne [10^i-1 | i <- [0..7]] == 1470

Soluciones

import Data.Char (digitToInt)

productoChampernowne :: [Int] -> Int
productoChampernowne ns = product [champernowne !! n | n <- ns] 

-- champernowne  es la sucesión de champernowne. Por ejemplo,
--    ghci> take 20 champernowne
--    [1,2,3,4,5,6,7,8,9,1,0,1,1,1,2,1,3,1,4,1]
champernowne :: [Int] 
champernowne = map digitToInt (concatMap show [1..])

import Data.Char (digitToInt)

productoChampernowne :: [Int] -> Int

productoChampernowne ns = product [champernowne !! n | n <- ns]

-- champernowne es la sucesión de champernowne. Por ejemplo,

-- ghci> take 20 champernowne

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

champernowne :: [Int]

champernowne = map digitToInt (concatMap show [1..])

Producto de un número por una lista de números

PorJosé A. Alonso 8-abril-20151-mayo-2015

El producto de un número natural x por una lista de números naturales ys es el número obtenido concatenando los productos de x por cada uno de los elementos de ys. Por ejemplo, el producto de 2 por [3,2,5] es 26410.

Definir la función

   producto :: Integer -> [Integer] -> Integer

1	producto :: Integer -> [Integer] -> Integer

tal que (producto x ys) es el producto de x por ys. Por ejemplo,

   producto  2 [3,2,5]  ==  6410
   producto 10 [3,2,5]  ==  302050

1 2	producto 2 [3,2,5] == 6410 producto 10 [3,2,5] == 302050

Soluciones

-- 1ª definición (por recursión):
producto1 :: Integer -> [Integer] -> Integer
producto1 x ys = read (aux x ys)
    where aux x []     = ""
          aux x (y:ys) = show (x*y) ++ aux x ys

-- 2ª definición (por plegado):
producto2 :: Integer -> [Integer] -> Integer
producto2 x ys = read (aux x ys)
    where aux x = foldr (\y -> (++) (show (x * y))) "" 

-- 3ª definición (por comprensión)
producto3 :: Integer -> [Integer] -> Integer
producto3 x ys = read (concat [show (x*y) | y <- ys])

-- 4ª definición (con map)
producto4 :: Integer -> [Integer] -> Integer
producto4 x ys = read (concat (map (show . (x*)) ys))

-- 5ª definición (con concatMap)
producto5 :: Integer -> [Integer] -> Integer
producto5 x = read . concatMap (show . (x*))

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

producto1 :: Integer -> [Integer] -> Integer

producto1 x ys = read (aux x ys)

where aux x [] = ""

aux x (y:ys) = show (x*y) ++ aux x ys

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

producto2 :: Integer -> [Integer] -> Integer

producto2 x ys = read (aux x ys)

where aux x = foldr (\y -> (++) (show (x * y))) ""

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

producto3 :: Integer -> [Integer] -> Integer

producto3 x ys = read (concat [show (x*y) | y <- ys])

-- 4ª definición (con map)

producto4 :: Integer -> [Integer] -> Integer

producto4 x ys = read (concat (map (show . (x*)) ys))

-- 5ª definición (con concatMap)

producto5 :: Integer -> [Integer] -> Integer

producto5 x = read . concatMap (show . (x*))

Ramas a las que pertenece un elemento

PorJosé A. Alonso 1-abril-20151-mayo-2015

Representamos los árboles binarios con elementos en las hojas y en los nodos mediante el tipo de dato

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

1	data Arbol a = H a \| N a (Arbol a) (Arbol a) deriving Show

Por ejemplo,

   ej1 :: Arbol Int
   ej1 = N 5 (N 2 (H 1) (H 2)) (N 3 (H 4) (H 2))

1 2	ej1 :: Arbol Int ej1 = N 5 (N 2 (H 1) (H 2)) (N 3 (H 4) (H 2))

Definir la función

   ramasCon :: Eq a => Arbol a -> a -> [[a]]

1	ramasCon :: Eq a => Arbol a -> a -> [[a]]

tal que (ramasCon a x) es la lista de las ramas del árbol a en las que aparece el elemento x. Por ejemplo,

  ramasCon ej1 2 ==  [[5,2,1],[5,2,2],[5,3,2]]

1	ramasCon ej1 2 == [[5,2,1],[5,2,2],[5,3,2]]

Soluciones

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

ej1 :: Arbol Int
ej1 = N 5 (N 2 (H 1) (H 2)) (N 3 (H 4) (H 2))

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

ramasCon :: Eq a => Arbol a -> a -> [[a]]
ramasCon a x = [ys | ys <- ramas a, x `elem` ys]

ramas :: Arbol a -> [[a]]
ramas (H x)     = [[x]]
ramas (N x i d) = [x:ys | ys <- ramas i ++ ramas d]

-- 2ª definición
-- =============

ramasCon2 :: Eq a => Arbol a -> a -> [[a]]
ramasCon2 a x = filter (x `elem`) (ramas2 a)

ramas2 :: Arbol a -> [[a]]
ramas2 (H x)     = [[x]]
ramas2 (N x i d) = map (x:) (ramas2 i ++ ramas2 d)

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

ej1 :: Arbol Int

ej1 = N 5 (N 2 (H 1) (H 2)) (N 3 (H 4) (H 2))

-- 1ª definición

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

ramasCon :: Eq a => Arbol a -> a -> [[a]]

ramasCon a x = [ys | ys <- ramas a, x `elem` ys]

ramas :: Arbol a -> [[a]]

ramas (H x) = [[x]]

ramas (N x i d) = [x:ys | ys <- ramas i ++ ramas d]

-- 2ª definición

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

ramasCon2 :: Eq a => Arbol a -> a -> [[a]]

ramasCon2 a x = filter (x `elem`) (ramas2 a)

ramas2 :: Arbol a -> [[a]]

ramas2 (H x) = [[x]]

ramas2 (N x i d) = map (x:) (ramas2 i ++ ramas2 d)

Agrupamiento de consecutivos iguales

PorJosé A. Alonso 30-marzo-20151-mayo-2016

Definir las funciones

   agrupa  :: Eq a => [a] -> [(a,Int)]
   expande :: [(a,Int)] -> [a]

1 2	agrupa :: Eq a => [a] -> [(a,Int)] expande :: [(a,Int)] -> [a]

tales que

(agrupa xs) es la lista obtenida agrupando las ocurrencias consecutivas de elementos de xs junto con el número de dichas ocurrencias. Por ejemplo:

     agrupa "aaabzzaa" == [('a',3),('b',1),('z',2),('a',2)]

1	agrupa "aaabzzaa" == [('a',3),('b',1),('z',2),('a',2)]

(expande xs) es la lista expandida correspondiente a ps (es decir, es la lista xs tal que la comprimida de xs es ps. Por ejemplo,

     expande [('a',2),('b',3),('a',1)] == "aabbba"

1	expande [('a',2),('b',3),('a',1)] == "aabbba"

Comprobar con QuickCheck que dada una lista de enteros, si se la agrupa y después se expande se obtiene la lista inicial.

Soluciones

import Data.List (group)
import Test.QuickCheck

-- Definiciones de agrupa
-- ======================

-- 1ª definición (por recursión)
agrupa :: Eq a => [a] -> [(a,Int)]
agrupa xs = aux xs 1
    where aux (x:y:zs) n | x == y    = aux (y:zs) (n+1)
                         | otherwise = (x,n) : aux (y:zs) 1
          aux [x]      n             = [(x,n)]
          aux []       _             = []

-- 2ª definición (por recursión usando takeWhile):
agrupa2 :: Eq a => [a] -> [(a,Int)]
agrupa2 [] = []
agrupa2 (x:xs) = 
    (x,1 + length (takeWhile (==x) xs)) : agrupa2 (dropWhile (==x) xs)

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

-- 4ª definición (usando map y group):
agrupa4 :: Eq a => [a] -> [(a,Int)]
agrupa4 = map (\xs -> (head xs, length xs)) . group

-- Definiciones de expande
-- =======================

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

-- 2ª definición (por concatMap)
expande2 :: [(a,Int)] -> [a]
expande2 = concatMap (\(x,k) -> replicate k x) 

-- 3ª definición (por recursión)
expande3 :: [(a,Int)] -> [a]
expande3 [] = []
expande3 ((x,n):ps) = replicate n x ++ expande3 ps

-- Comprobación
-- ============

-- La propiedad es
prop_expande_agrupa :: [Int] -> Bool 
prop_expande_agrupa xs = expande (agrupa xs) == xs

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

import Data.List (group)

import Test.QuickCheck

-- Definiciones de agrupa

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

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

agrupa :: Eq a => [a] -> [(a,Int)]

agrupa xs = aux xs 1

where aux (x:y:zs) n | x == y = aux (y:zs) (n+1)

| otherwise = (x,n) : aux (y:zs) 1

aux [x] n = [(x,n)]

aux [] _ = []

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

agrupa2 :: Eq a => [a] -> [(a,Int)]

agrupa2 [] = []

agrupa2 (x:xs) =

(x,1 + length (takeWhile (==x) xs)) : agrupa2 (dropWhile (==x) xs)

-- 3ª definición (por comprensión usando group):

agrupa3 :: Eq a => [a] -> [(a,Int)]

agrupa3 xs = [(head ys,length ys) | ys <- group xs]

-- 4ª definición (usando map y group):

agrupa4 :: Eq a => [a] -> [(a,Int)]

agrupa4 = map (\xs -> (head xs, length xs)) . group

-- Definiciones de expande

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

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

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

expande ps = concat [replicate k x | (x,k) <- ps]

-- 2ª definición (por concatMap)

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

expande2 = concatMap (\(x,k) -> replicate k x)

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

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

expande3 [] = []

expande3 ((x,n):ps) = replicate n x ++ expande3 ps

-- Comprobación

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

-- La propiedad es

prop_expande_agrupa :: [Int] -> Bool

prop_expande_agrupa xs = expande (agrupa xs) == xs

-- La comprobación es

-- ghci> quickCheck prop_expande_agrupa

-- +++ OK, passed 100 tests.

Números de suma prima hereditarios por la derecha

PorJosé A. Alonso 27-marzo-20151-mayo-2015

Decimos que un número es de suma prima si la suma de todos sus dígitos es un número primo. Por ejemplo el número 562 es de suma prima pues la suma de sus dígitos es el número primo 13; sin embargo, el número 514 no es de suma prima pues la suma de sus dígitos es 10, que no es primo.

Decimos que un número es de suma prima hereditario por la derecha si es de suma prima y los números que se obtienen eliminando sus últimas cifras también son de suma prima. Por ejemplo 7426 es de suma prima hereditario por la derecha pues 7426, 742, 74 y 7 son todos números de suma prima.

Definir la constante

   listaSumaPrimaHD :: [Integer]

1	listaSumaPrimaHD :: [Integer]

cuyo valor es la lista infinita de los números de suma prima hereditarios por la derecha. Por ejemplo,

   take 10 listaSumaPrimaHD     ==  [2,3,5,7,20,21,23,25,29,30]
   listaSumaPrimaHD !! 2000000  ==  3800024668046

1 2	take 10 listaSumaPrimaHD == [2,3,5,7,20,21,23,25,29,30] listaSumaPrimaHD !! 2000000 == 3800024668046

Soluciones

import Data.Char (digitToInt)
import Data.Array
import Data.Numbers.Primes (isPrime)

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

listaSumaPrimaHD1 :: [Integer]
listaSumaPrimaHD1 = filter sumaPrimaHD [1..]

-- (sumaPrimaHD n) se verifica si n es de suma prima hereditario por la
-- derecha. Por ejemplo,
--    sumaPrimaHD 7426  ==  True
--    sumaPrimaHD 7427  ==  False
sumaPrimaHD n
    | n < 10    = isPrime n
    | otherwise = sumaPrima n && sumaPrimaHD (n `div` 10)

-- (sumaPrima n) se verifica si n es un número de suma prima. Por
-- ejemplo, 
--    sumaPrima 562  ==  True
--    sumaPrima 514  ==  False
sumaPrima :: Integer -> Bool
sumaPrima = isPrime . sum . digitos

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,
--    digitos 325  ==  [3,2,5]
digitos :: Integer -> [Integer]
digitos = map (fromIntegral . digitToInt) . show


-- 2ª definición
-- =============

listaSumaPrimaHD2 :: [Integer]
listaSumaPrimaHD2 = map fst paresSumaPrimaHDDigitos

paresSumaPrimaHDDigitos :: [(Integer, Integer)]
paresSumaPrimaHDDigitos =
    paresSumaPrimaHDDigitosAux 1 [(2,2),(3,3),(5,5),(7,7)]

paresSumaPrimaHDDigitosAux :: Integer -> [(Integer,Integer)] -> 
                              [(Integer,Integer)]
paresSumaPrimaHDDigitosAux n ac =
    ac ++ paresSumaPrimaHDDigitosAux (n+1) 
                                     (concatMap extiendeSumaPrimaHD ac)

extiendeSumaPrimaHD :: (Integer,Integer) -> [(Integer,Integer)]
extiendeSumaPrimaHD (n,s) = [(n*10+k,s+k) | k <- [0..9], isPrime (s+k)]

-- 3ª definición
-- =============

listaSumaPrimaHD3 :: [Integer]
listaSumaPrimaHD3 = 
    map fst (concat (iterate (concatMap extiendeSumaPrimaHD3) 
                             [(2,2),(3,3),(5,5),(7,7)]))

extiendeSumaPrimaHD3 :: (Integer,Integer) -> [(Integer,Integer)]
extiendeSumaPrimaHD3 (n,s) = [(n*10+k,s+k) | k <- extensiones ! s]

extensiones :: Array Integer [Integer]
extensiones = array (1,1000) 
              [(n,[k | k <- [0..9], isPrime (n+k)]) | n <- [1..1000]]

-- Comparación de eficiencia
-- =========================

--    ghci> listaSumaPrimaHD1 !! 600
--    34004
--    (2.47 secs, 1565301720 bytes)
--    ghci> listaSumaPrimaHD2 !! 600
--    34004
--    (0.02 secs, 7209000 bytes)
--    ghci> listaSumaPrimaHD3 !! 600
--    34004
--    (0.01 secs, 1579920 bytes)
-- 
--    ghci> listaSumaPrimaHD2 !! 2000000
--    3800024668046
--    (45.41 secs, 29056613824 bytes)
--    ghci> listaSumaPrimaHD3 !! 2000000
--    3800024668046
--    (4.29 secs, 973265400 bytes)

import Data.Char (digitToInt)

import Data.Array

import Data.Numbers.Primes (isPrime)

-- 1ª definición

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

listaSumaPrimaHD1 :: [Integer]

listaSumaPrimaHD1 = filter sumaPrimaHD [1..]

-- (sumaPrimaHD n) se verifica si n es de suma prima hereditario por la

-- derecha. Por ejemplo,

-- sumaPrimaHD 7426 == True

-- sumaPrimaHD 7427 == False

sumaPrimaHD n

| n < 10 = isPrime n

| otherwise = sumaPrima n && sumaPrimaHD (n `div` 10)

-- (sumaPrima n) se verifica si n es un número de suma prima. Por

-- ejemplo,

-- sumaPrima 562 == True

-- sumaPrima 514 == False

sumaPrima :: Integer -> Bool

sumaPrima = isPrime . sum . digitos

-- (digitos n) es la lista de los dígitos de n. Por ejemplo,

-- digitos 325 == [3,2,5]

digitos :: Integer -> [Integer]

digitos = map (fromIntegral . digitToInt) . show

-- 2ª definición

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

listaSumaPrimaHD2 :: [Integer]

listaSumaPrimaHD2 = map fst paresSumaPrimaHDDigitos

paresSumaPrimaHDDigitos :: [(Integer, Integer)]

paresSumaPrimaHDDigitos =

paresSumaPrimaHDDigitosAux 1 [(2,2),(3,3),(5,5),(7,7)]

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

[(Integer,Integer)]

paresSumaPrimaHDDigitosAux n ac =

ac ++ paresSumaPrimaHDDigitosAux (n+1)

(concatMap extiendeSumaPrimaHD ac)

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

extiendeSumaPrimaHD (n,s) = [(n*10+k,s+k) | k <- [0..9], isPrime (s+k)]

-- 3ª definición

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

listaSumaPrimaHD3 :: [Integer]

listaSumaPrimaHD3 =

map fst (concat (iterate (concatMap extiendeSumaPrimaHD3)

[(2,2),(3,3),(5,5),(7,7)]))

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

extiendeSumaPrimaHD3 (n,s) = [(n*10+k,s+k) | k <- extensiones ! s]

extensiones :: Array Integer [Integer]

extensiones = array (1,1000)

[(n,[k | k <- [0..9], isPrime (n+k)]) | n <- [1..1000]]

-- Comparación de eficiencia

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

-- ghci> listaSumaPrimaHD1 !! 600

-- 34004

-- (2.47 secs, 1565301720 bytes)

-- ghci> listaSumaPrimaHD2 !! 600

-- 34004

-- (0.02 secs, 7209000 bytes)

-- ghci> listaSumaPrimaHD3 !! 600

-- 34004

-- (0.01 secs, 1579920 bytes)

-- ghci> listaSumaPrimaHD2 !! 2000000

-- 3800024668046

-- (45.41 secs, 29056613824 bytes)

-- ghci> listaSumaPrimaHD3 !! 2000000

-- 3800024668046

-- (4.29 secs, 973265400 bytes)

Pares como sumas de pares

PorJosé A. Alonso 26-marzo-20151-mayo-2015

Todo número par se puede escribir como suma de números pares de varias formas. Por ejemplo,

   8 = 8 
     = 6 + 2
     = 4 + 4
     = 4 + 2 + 2
     = 2 + 2 + 2 + 2

8 = 8

= 6 + 2

= 4 + 4

= 4 + 2 + 2

= 2 + 2 + 2 + 2

Definir la función

   descomposicionesDecrecientes:: Integer -> [[Integer]]

1	descomposicionesDecrecientes:: Integer -> [[Integer]]

tal que (descomposicionesDecrecientes n) es la lista con las descomposiciones de n como suma de pares, en forma decreciente. Por ejemplo,

   ghci> descomposicionesDecrecientes 8
   [[8],[6,2],[4,4],[4,2,2],[2,2,2,2]]
   ghci> descomposicionesDecrecientes 10
   [[10],[8,2],[6,4],[6,2,2],[4,4,2],[4,2,2,2],[2,2,2,2,2]]
   ghci> length (descomposicionesDecrecientes 100)
   204226

ghci> descomposicionesDecrecientes 8

[[8],[6,2],[4,4],[4,2,2],[2,2,2,2]]

ghci> descomposicionesDecrecientes 10

[[10],[8,2],[6,4],[6,2,2],[4,4,2],[4,2,2,2],[2,2,2,2,2]]

ghci> length (descomposicionesDecrecientes 100)

204226

Soluciones

descomposicionesDecrecientes:: Integer -> [[Integer]]
descomposicionesDecrecientes 0 = [[0]]
descomposicionesDecrecientes n = aux n [n,n-2..2]
    where aux _ [] = []
          aux n (x:xs) | x > n     = aux n xs
                       | x == n    = [n] : aux n xs
                       | otherwise = map (x:) (aux (n-x) (x:xs)) ++ aux n xs

descomposicionesDecrecientes:: Integer -> [[Integer]]

descomposicionesDecrecientes 0 = [[0]]

descomposicionesDecrecientes n = aux n [n,n-2..2]

where aux _ [] = []

aux n (x:xs) | x > n = aux n xs

| x == n = [n] : aux n xs

| otherwise = map (x:) (aux (n-x) (x:xs)) ++ aux n xs

Caminos maximales en árboles binarios

PorJosé A. Alonso 23-marzo-20151-mayo-2015

Consideremos los árboles binarios con etiquetas en las hojas y en los nodos. Por ejemplo,

/ \

2 4

/ \

7 1

/ \

2 3

Un camino es una sucesión de nodos desde la raiz hasta una hoja. Por ejemplo, [5,2] y [5,4,1,2] son caminos que llevan a 2, mientras que [5,4,1] no es un camino, pues no lleva a una hoja.

Definimos el tipo de dato Arbol y el ejemplo por

   data Arbol = H Int | N Arbol Int Arbol 
                deriving Show
   
   arb1:: Arbol 
   arb1 = N (H 2) 5 (N (H 7) 4 (N (H 2) 1 (H 3)))

data Arbol = H Int | N Arbol Int Arbol

deriving Show

arb1:: Arbol

arb1 = N (H 2) 5 (N (H 7) 4 (N (H 2) 1 (H 3)))

Definir la función

   maxLong :: Int -> Arbol -> Int

1	maxLong :: Int -> Arbol -> Int

tal que (maxLong x a) es la longitud máxima de los caminos que terminan en x. Por ejemplo,

   maxLong 3 arb1 == 4
   maxLong 2 arb1 == 4
   maxLong 7 arb1 == 3

maxLong 3 arb1 == 4

maxLong 2 arb1 == 4

maxLong 7 arb1 == 3

Soluciones

data Arbol = H Int | N Arbol Int Arbol 
             deriving Show

arb1:: Arbol 
arb1 = N (H 2) 5 (N (H 7) 4 (N (H 2) 1 (H 3)))

-- 1ª solución (calculando los caminos)
-- ------------------------------------

-- (caminos x a) es la lista de los caminos en el árbol a desde la raíz
-- hasta las hojas x. Por ejemplo,
--    caminos 2 arb1 == [[5,2],[5,4,1,2]]
--    caminos 3 arb1 == [[5,4,1,3]]
--    caminos 1 arb1 == []
caminos :: Int -> Arbol -> [[Int]]
caminos x (H y) | x == y    = [[x]]
                | otherwise = []
caminos x (N i r d) = map (r:) (caminos x i ++ caminos x d)

maxLong1 :: Int -> Arbol -> Int
maxLong1 x a = maximum (0: map length (caminos x a))

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

maxLong2 :: Int -> Arbol -> Int
maxLong2 x a = maximum (0 : aux x a)
    where aux x (H y) | x == y    = [1]
                      | otherwise = []
          aux x (N i r d) = map (+1) (aux x i ++ aux x d)

data Arbol = H Int | N Arbol Int Arbol

deriving Show

arb1:: Arbol

arb1 = N (H 2) 5 (N (H 7) 4 (N (H 2) 1 (H 3)))

-- 1ª solución (calculando los caminos)

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

-- (caminos x a) es la lista de los caminos en el árbol a desde la raíz

-- hasta las hojas x. Por ejemplo,

-- caminos 2 arb1 == [[5,2],[5,4,1,2]]

-- caminos 3 arb1 == [[5,4,1,3]]

-- caminos 1 arb1 == []

caminos :: Int -> Arbol -> [[Int]]

caminos x (H y) | x == y = [[x]]

| otherwise = []

caminos x (N i r d) = map (r:) (caminos x i ++ caminos x d)

maxLong1 :: Int -> Arbol -> Int

maxLong1 x a = maximum (0: map length (caminos x a))

-- 2ª solución

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

maxLong2 :: Int -> Arbol -> Int

maxLong2 x a = maximum (0 : aux x a)

where aux x (H y) | x == y = [1]

| otherwise = []

aux x (N i r d) = map (+1) (aux x i ++ aux x d)

Orden de divisibilidad

PorJosé A. Alonso 9-marzo-201525-abril-2021

El orden de divisibilidad de un número x es el mayor n tal que para todo i menor o igual que n, los i primeros dígitos de n es divisible por i. Por ejemplo, el orden de divisibilidad de 74156 es 3 porque

   7       es divisible por 1
   74      es divisible por 2
   741     es divisible por 3
   7415 no es divisible por 4

7 es divisible por 1

74 es divisible por 2

741 es divisible por 3

7415 no es divisible por 4

Definir la función

   ordenDeDivisibilidad :: Integer -> Int

1	ordenDeDivisibilidad :: Integer -> Int

tal que (ordenDeDivisibilidad x) es el orden de divisibilidad de x. Por ejemplo,

   ordenDeDivisibilidad 74156                      ==  3
   ordenDeDivisibilidad 3608528850368400786036725  ==  25

1 2	ordenDeDivisibilidad 74156 == 3 ordenDeDivisibilidad 3608528850368400786036725 == 25

Soluciones

import Data.List (inits)

-- 1ª definición de ordenDeDivisibilidad
-- =====================================

ordenDeDivisibilidad :: Integer -> Int
ordenDeDivisibilidad n = 
    length (takeWhile (\(x,k) -> x `mod` k == 0) (zip (sucDigitos n) [1..]))

-- (sucDigitos x) es la sucesión de los dígitos de x. Por ejemplo,
--    sucDigitos 325    ==  [3,32,325]
--    sucDigitos 32050  ==  [3,32,320,3205,32050]
sucDigitos :: Integer -> [Integer]
sucDigitos n = 
    [n `div` (10^i) | i <- [k-1,k-2..0]]
    where k = length (show n)

-- 2ª definición de sucDigitos
sucDigitos2 :: Integer -> [Integer]
sucDigitos2 n = [read xs | xs <- aux (show n)]
    where aux []     = []
          aux (d:ds) = [d] : map (d:) (aux ds)

-- 3ª definición de sucDigitos
sucDigitos3 :: Integer -> [Integer]
sucDigitos3 n = 
    [read (take k ds) | k <- [1..length ds]]
    where ds = show n

-- 4ª definición de sucDigitos
sucDigitos4 :: Integer -> [Integer]
sucDigitos4 n = [read xs | xs <- tail (inits (show n))]

-- 5ª definición de sucDigitos
sucDigitos5 :: Integer -> [Integer]
sucDigitos5 n = map read (tail (inits (show n)))

-- 6ª definición de sucDigitos
sucDigitos6 :: Integer -> [Integer]
sucDigitos6 = map read . (tail . inits . show)

-- Eficiencia de las definiciones de sucDigitos
--    ghci> length (sucDigitos (10^5000))
--    5001
--    (0.01 secs, 1550688 bytes)
--    ghci> length (sucDigitos2 (10^5000))
--    5001
--    (1.25 secs, 729411872 bytes)
--    ghci> length (sucDigitos3 (10^5000))
--    5001
--    (0.02 secs, 2265120 bytes)
--    ghci> length (sucDigitos4 (10^5000))
--    5001
--    (1.10 secs, 728366872 bytes)
--    ghci> length (sucDigitos5 (10^5000))
--    5001
--    (1.12 secs, 728393864 bytes)
--    ghci> length (sucDigitos6 (10^5000))
--    5001
--    (1.20 secs, 728403052 bytes)
-- 
--    ghci> length (sucDigitos (10^3000000))
--    3000001
--    (2.73 secs, 820042696 bytes)
--    ghci> length (sucDigitos3 (10^3000000))
--    3000001
--    (3.69 secs, 820043688 bytes)

-- 2ª definición de ordenDeDivisibilidad
-- =====================================

ordenDeDivisibilidad :: Integer -> Int
ordenDeDivisibilidad x =
    length $ takeWhile (==0) $ zipWith (mod . read) (tail $ inits $ show x) [1..]

import Data.List (inits)

-- 1ª definición de ordenDeDivisibilidad

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

ordenDeDivisibilidad :: Integer -> Int

ordenDeDivisibilidad n =

length (takeWhile (\(x,k) -> x `mod` k == 0) (zip (sucDigitos n) [1..]))

-- (sucDigitos x) es la sucesión de los dígitos de x. Por ejemplo,

-- sucDigitos 325 == [3,32,325]

-- sucDigitos 32050 == [3,32,320,3205,32050]

sucDigitos :: Integer -> [Integer]

sucDigitos n =

[n `div` (10^i) | i <- [k-1,k-2..0]]

where k = length (show n)

-- 2ª definición de sucDigitos

sucDigitos2 :: Integer -> [Integer]

sucDigitos2 n = [read xs | xs <- aux (show n)]

where aux [] = []

aux (d:ds) = [d] : map (d:) (aux ds)

-- 3ª definición de sucDigitos

sucDigitos3 :: Integer -> [Integer]

sucDigitos3 n =

[read (take k ds) | k <- [1..length ds]]

where ds = show n

-- 4ª definición de sucDigitos

sucDigitos4 :: Integer -> [Integer]

sucDigitos4 n = [read xs | xs <- tail (inits (show n))]

-- 5ª definición de sucDigitos

sucDigitos5 :: Integer -> [Integer]

sucDigitos5 n = map read (tail (inits (show n)))

-- 6ª definición de sucDigitos

sucDigitos6 :: Integer -> [Integer]

sucDigitos6 = map read . (tail . inits . show)

-- Eficiencia de las definiciones de sucDigitos

-- ghci> length (sucDigitos (10^5000))

-- 5001

-- (0.01 secs, 1550688 bytes)

-- ghci> length (sucDigitos2 (10^5000))

-- 5001

-- (1.25 secs, 729411872 bytes)

-- ghci> length (sucDigitos3 (10^5000))

-- 5001

-- (0.02 secs, 2265120 bytes)

-- ghci> length (sucDigitos4 (10^5000))

-- 5001

-- (1.10 secs, 728366872 bytes)

-- ghci> length (sucDigitos5 (10^5000))

-- 5001

-- (1.12 secs, 728393864 bytes)

-- ghci> length (sucDigitos6 (10^5000))

-- 5001

-- (1.20 secs, 728403052 bytes)

-- ghci> length (sucDigitos (10^3000000))

-- 3000001

-- (2.73 secs, 820042696 bytes)

-- ghci> length (sucDigitos3 (10^3000000))

-- 3000001

-- (3.69 secs, 820043688 bytes)

-- 2ª definición de ordenDeDivisibilidad

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

ordenDeDivisibilidad :: Integer -> Int

ordenDeDivisibilidad x =

length $ takeWhile (==0) $ zipWith (mod . read) (tail $ inits $ show x) [1..]

Caminos en un árbol binario

PorJosé A. Alonso 5-marzo-20151-mayo-2016

Los caminos en los árboles binarios

       .          .
      / \        / \
     .   .      /   \
    / \        .     .
   .   .      / \   / \
             .   . .   .

. .

/ \ / \

. . / \

/ \ . .

. . / \ / \

. . . .

son [[I,I],[I,D],[D]] y [[I,I],[I,D],[D,I],[D,D]], donde I indica un movimiento hacia la izquierda y D uno hacia la derecha.

Los árboles binarios se pueden representar por

   data Arbol = H | N Arbol Arbol

1	data Arbol = H \| N Arbol Arbol

los movimientos por

   data Mov    = I | D deriving Show

1	data Mov = I \| D deriving Show

y los caminos por

   type Camino = [Mov]

1	type Camino = [Mov]

Definir la función

   caminos :: Arbol -> [Camino]

1	caminos :: Arbol -> [Camino]

tal que (caminos a) es la lista de los caminos en el árbol binario a. Por ejemplo,

   caminos (N (N H H) H)             == [[I,I],[I,D],[D]]
   caminos (N (N H H) (N H H))       == [[I,I],[I,D],[D,I],[D,D]]
   caminos (N H (N (N H H) (N H H))) == [[I],[D,I,I],[D,I,D],[D,D,I],[D,D,D]]

caminos (N (N H H) H) == [[I,I],[I,D],[D]]

caminos (N (N H H) (N H H)) == [[I,I],[I,D],[D,I],[D,D]]

caminos (N H (N (N H H) (N H H))) == [[I],[D,I,I],[D,I,D],[D,D,I],[D,D,D]]

Soluciones

data Arbol  = H | N Arbol Arbol
data Mov    = I | D deriving Show
type Camino = [Mov]

caminos :: Arbol -> [Camino]
caminos H       = [[]]
caminos (N i d) = [I:xs | xs <- caminos i] ++ [D:xs | xs <- caminos d]

data Arbol = H | N Arbol Arbol

data Mov = I | D deriving Show

type Camino = [Mov]

caminos :: Arbol -> [Camino]

caminos H = [[]]

caminos (N i d) = [I:xs | xs <- caminos i] ++ [D:xs | xs <- caminos d]

Suma de conjuntos de polinomios

PorJosé A. Alonso 25-febrero-20151-mayo-2016

Los conjuntos de polinomios se pueden representar por listas de listas de la misma longitud. Por ejemplo, los polinomios 3x²+5x+9, 10x³+9 y 8x³+5x²+x-1 se pueden representar por las listas [0,3,5,9], [10,0,0,9] y [8,5,1,-1].

Definir la función

   sumaPolinomios :: Num a => [[a]] -> [a]

1	sumaPolinomios :: Num a => [[a]] -> [a]

tal que (sumaPolinomios ps) es la suma de los polinomios ps. Por ejemplo,

   ghci> sumaPolinomios1 [[0,3,5,9],[10,0,0,9],[8,5,1,-1]]
   [18,8,6,17]
   ghci> sumaPolinomios6 (replicate 1000000 (replicate 3 1))
   [1000000,1000000,1000000]

ghci> sumaPolinomios1 [[0,3,5,9],[10,0,0,9],[8,5,1,-1]]

[18,8,6,17]

ghci> sumaPolinomios6 (replicate 1000000 (replicate 3 1))

[1000000,1000000,1000000]

Soluciones

import Data.List (transpose)
import Data.Array ((!),accumArray,elems,listArray)

-- 1ª definición (por recursión):
sumaPolinomios1 :: Num a => [[a]] -> [a]
sumaPolinomios1 []          = []
sumaPolinomios1 [xs]        = xs
sumaPolinomios1 (xs:ys:zss) = suma xs (sumaPolinomios1 (ys:zss))

-- (suma xs ys) es la suma de los vectores xs e ys. Por ejemplo,
--    suma [4,7,3] [1,2,5]  == [5,9,8]
suma :: Num a => [a] -> [a] -> [a]
suma [] []         = []
suma (x:xs) (y:ys) = x+y : suma xs ys

-- 2ª definición (por recursión con zipWith): 
sumaPolinomios2 :: Num a => [[a]] -> [a]
sumaPolinomios2 []       = []
sumaPolinomios2 [xs]     = xs
sumaPolinomios2 (xs:xss) = zipWith (+) xs (sumaPolinomios2 xss)

-- 3ª definición (por plegado)
sumaPolinomios3 :: Num a => [[a]] -> [a]
sumaPolinomios3 = foldr1 (zipWith (+))

-- 4ª definición (por comprensión con transpose):
sumaPolinomios4 :: Num a => [[a]] -> [a]
sumaPolinomios4 xss = [sum xs | xs <- transpose xss]

-- 5ª definición (con map y transpose):
sumaPolinomios5 :: Num a => [[a]] -> [a]
sumaPolinomios5 = map sum . transpose 

-- 6ª definición (con array)
sumaPolinomios6 :: Num a => [[a]] -> [a]
sumaPolinomios6 xss = [sum [p!(i,j) | i <- [1..m]] | j <- [1..n]] 
    where m = length xss
          n = length (head xss)
          p = listArray ((1,1),(m,n)) (concat xss) 

-- 7ª definición (con accumArray)
sumaPolinomios7 :: Num a => [[a]] -> [a]
sumaPolinomios7 xss = 
    elems $ accumArray (+) 0 (1,n) (concat [zip [1..] xs | xs <- xss])
    where n = length (head xss)

-- Comparación de eficiencia
--    ghci> sumaPolinomios1 (replicate 300000 (replicate 5 1))
--    [300000,300000,300000,300000,300000]
--    (3.94 secs, 354713532 bytes)
--    
--    ghci> sumaPolinomios2 (replicate 300000 (replicate 5 1))
--    [300000,300000,300000,300000,300000]
--    (2.08 secs, 185506908 bytes)
--    
--    ghci> sumaPolinomios3 (replicate 300000 (replicate 5 1))
--    [300000,300000,300000,300000,300000]
--    (1.48 secs, 167026728 bytes)
--    
--    ghci> sumaPolinomios4 (replicate 300000 (replicate 5 1))
--    [300000,300000,300000,300000,300000]
--    (1.08 secs, 148564752 bytes)
--    
--    ghci> sumaPolinomios5 (replicate 300000 (replicate 5 1))
--    [300000,300000,300000,300000,300000]
--    (1.02 secs, 148062764 bytes)
--    
--    ghci> sumaPolinomios6 (replicate 300000 (replicate 5 1))
--    [300000,300000,300000,300000,300000]
--    (3.17 secs, 463756028 bytes)
--    
--    ghci> sumaPolinomios7 (replicate 300000 (replicate 5 1))
--    [300000,300000,300000,300000,300000]
--    (1.50 secs, 291699548 bytes)

import Data.List (transpose)

import Data.Array ((!),accumArray,elems,listArray)

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

sumaPolinomios1 :: Num a => [[a]] -> [a]

sumaPolinomios1 [] = []

sumaPolinomios1 [xs] = xs

sumaPolinomios1 (xs:ys:zss) = suma xs (sumaPolinomios1 (ys:zss))

-- (suma xs ys) es la suma de los vectores xs e ys. Por ejemplo,

-- suma [4,7,3] [1,2,5] == [5,9,8]

suma :: Num a => [a] -> [a] -> [a]

suma [] [] = []

suma (x:xs) (y:ys) = x+y : suma xs ys

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

sumaPolinomios2 :: Num a => [[a]] -> [a]

sumaPolinomios2 [] = []

sumaPolinomios2 [xs] = xs

sumaPolinomios2 (xs:xss) = zipWith (+) xs (sumaPolinomios2 xss)

-- 3ª definición (por plegado)

sumaPolinomios3 :: Num a => [[a]] -> [a]

sumaPolinomios3 = foldr1 (zipWith (+))

-- 4ª definición (por comprensión con transpose):

sumaPolinomios4 :: Num a => [[a]] -> [a]

sumaPolinomios4 xss = [sum xs | xs <- transpose xss]

-- 5ª definición (con map y transpose):

sumaPolinomios5 :: Num a => [[a]] -> [a]

sumaPolinomios5 = map sum . transpose

-- 6ª definición (con array)

sumaPolinomios6 :: Num a => [[a]] -> [a]

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

where m = length xss

n = length (head xss)

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

-- 7ª definición (con accumArray)

sumaPolinomios7 :: Num a => [[a]] -> [a]

sumaPolinomios7 xss =

elems $ accumArray (+) 0 (1,n) (concat [zip [1..] xs | xs <- xss])

where n = length (head xss)

-- Comparación de eficiencia

-- ghci> sumaPolinomios1 (replicate 300000 (replicate 5 1))

-- [300000,300000,300000,300000,300000]

-- (3.94 secs, 354713532 bytes)

-- ghci> sumaPolinomios2 (replicate 300000 (replicate 5 1))

-- [300000,300000,300000,300000,300000]

-- (2.08 secs, 185506908 bytes)

-- ghci> sumaPolinomios3 (replicate 300000 (replicate 5 1))

-- [300000,300000,300000,300000,300000]

-- (1.48 secs, 167026728 bytes)

-- ghci> sumaPolinomios4 (replicate 300000 (replicate 5 1))

-- [300000,300000,300000,300000,300000]

-- (1.08 secs, 148564752 bytes)

-- ghci> sumaPolinomios5 (replicate 300000 (replicate 5 1))

-- [300000,300000,300000,300000,300000]

-- (1.02 secs, 148062764 bytes)

-- ghci> sumaPolinomios6 (replicate 300000 (replicate 5 1))

-- [300000,300000,300000,300000,300000]

-- (3.17 secs, 463756028 bytes)

-- ghci> sumaPolinomios7 (replicate 300000 (replicate 5 1))

-- [300000,300000,300000,300000,300000]

-- (1.50 secs, 291699548 bytes)

Mayor producto de n dígitos consecutivos de un número

PorJosé A. Alonso 12-febrero-201525-abril-2021

Definir la función

   mayorProducto :: Int -> Integer -> Integer

1	mayorProducto :: Int -> Integer -> Integer

tal que (mayorProducto n x) es el mayor producto de n dígitos consecutivos del número x (suponiendo que x tiene al menos n dígitos). Por ejemplo,

   mayorProducto 2 325                  ==  10
   mayorProducto 5 11111                ==  1
   mayorProducto 5 113111               ==  3
   mayorProducto 5 110111               ==  0
   mayorProducto 5 10151112             ==  10
   mayorProducto 5 101511124            ==  10
   mayorProducto 5 (product [1..1000])  ==  41472

mayorProducto 2 325 == 10

mayorProducto 5 11111 == 1

mayorProducto 5 113111 == 3

mayorProducto 5 110111 == 0

mayorProducto 5 10151112 == 10

mayorProducto 5 101511124 == 10

mayorProducto 5 (product [1..1000]) == 41472

Soluciones

import Data.List (inits, tails)
import Data.Char (digitToInt)

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

mayorProducto1 :: Int -> Integer -> Integer
mayorProducto1 n x = 
    maximum [product xs | xs <- segmentos n (cifras x)]

-- (cifras x) es la lista de las cifras del número x, de derecha a
-- izquierda. Por ejemplo, 
--    cifras 325  ==  [5,2,3]
cifras :: Integer -> [Integer]
cifras x 
    | x < 10    = [x]
    | otherwise = r : cifras q
    where (q,r) = quotRem x 10

-- (segmentos n xs) es la lista de los segmentos de longitud n de la
-- lista xs. Por ejemplo,
--    segmentos 2 [3,5,4,6]  ==  [[3,5],[5,4],[4,6]]
segmentos :: Int -> [Integer] -> [[Integer]]
segmentos n xs = take (length xs - n + 1) (map (take n) (tails xs))

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

mayorProducto2 :: Int -> Integer -> Integer
mayorProducto2 n x = maximum (aux ns)
    where ns     = [read [d] | d <- show x]
          aux xs | length xs < n = []
                 | otherwise     = product (take n xs) : aux (tail xs)

-- 3ª solución
-- ===========

mayorProducto3 :: Int -> Integer -> Integer
mayorProducto3 n = maximum . 
                   map (product . take n) .
                   filter ((>=n) . length) .
                   tails . 
                   cifras

-- 4ª solución
-- ===========

mayorProducto4 :: Int -> Integer -> Integer
mayorProducto4 n = maximum . 
                   map (product . map (fromIntegral . digitToInt)) . 
                   filter ((==n) . length) . 
                   concatMap inits . 
                   tails .
                   show

-- ---------------------------------------------------------------------
-- Comparación de soluciones                                          --
-- ---------------------------------------------------------------------

-- Tiempo (en segundos) del cálculo de (mayorProducto4 5 (product [1..]))
-- 
--    | Def | 10   | 100  | 1000 | 5000  |
--    |-----+------+------+------+-------|
--    | 1   | 0.01 | 0.01 | 0.04 |  0.34 |
--    | 2   | 0.01 | 0.01 | 0.07 |  2.86 |
--    | 3   | 0.01 | 0.01 | 0.06 | 12.48 |
--    | 4   | 0.00 | 0.12 |      |       |
...

import Data.List (inits, tails)

import Data.Char (digitToInt)

-- 1ª solución

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

mayorProducto1 :: Int -> Integer -> Integer

mayorProducto1 n x =

maximum [product xs | xs <- segmentos n (cifras x)]

-- (cifras x) es la lista de las cifras del número x, de derecha a

-- izquierda. Por ejemplo,

-- cifras 325 == [5,2,3]

cifras :: Integer -> [Integer]

cifras x

| x < 10 = [x]

| otherwise = r : cifras q

where (q,r) = quotRem x 10

-- (segmentos n xs) es la lista de los segmentos de longitud n de la

-- lista xs. Por ejemplo,

-- segmentos 2 [3,5,4,6] == [[3,5],[5,4],[4,6]]

segmentos :: Int -> [Integer] -> [[Integer]]

segmentos n xs = take (length xs - n + 1) (map (take n) (tails xs))

-- 2ª solución

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

mayorProducto2 :: Int -> Integer -> Integer

mayorProducto2 n x = maximum (aux ns)

where ns = [read [d] | d <- show x]

aux xs | length xs < n = []

| otherwise = product (take n xs) : aux (tail xs)

-- 3ª solución

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

mayorProducto3 :: Int -> Integer -> Integer

mayorProducto3 n = maximum .

map (product . take n) .

filter ((>=n) . length) .

tails .

cifras

-- 4ª solución

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

mayorProducto4 :: Int -> Integer -> Integer

mayorProducto4 n = maximum .

map (product . map (fromIntegral . digitToInt)) .

filter ((==n) . length) .

concatMap inits .

tails .

show

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

-- Comparación de soluciones --

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

-- Tiempo (en segundos) del cálculo de (mayorProducto4 5 (product [1..]))

-- | Def | 10 | 100 | 1000 | 5000 |

-- |-----+------+------+------+-------|

-- | 1 | 0.01 | 0.01 | 0.04 | 0.34 |

-- | 2 | 0.01 | 0.01 | 0.07 | 2.86 |

-- | 3 | 0.01 | 0.01 | 0.06 | 12.48 |

-- | 4 | 0.00 | 0.12 | | |

...

Segmentos de longitud dada

PorJosé A. Alonso 10-febrero-20151-mayo-2016

Definir la función

   segmentos :: Int -> [a] -> [[a]]

1	segmentos :: Int -> [a] -> [[a]]

tal que (segmentos n xs) es la lista de los segmentos de longitud n de la lista xs. Por ejemplo,

   segmentos 3 [1..5]  ==  [[1,2,3],[2,3,4],[3,4,5]]

1	segmentos 3 [1..5] == [[1,2,3],[2,3,4],[3,4,5]]

Soluciones

import Data.List (tails)

-- 1ª definición (por recursión)
segmentos1 :: Int -> [a] -> [[a]]
segmentos1 n xs 
    | length xs < n = []
    | otherwise     = take n xs : segmentos1 n (tail xs)
                  
-- 2ª definición (con tails):
segmentos2 :: Int -> [a] -> [[a]]
segmentos2 n xs = 
    takeWhile (\ys -> length ys == n) (map (take n) (tails xs))

-- 3ª definición:
segmentos3 :: Int -> [a] -> [[a]]
segmentos3 n xs = 
    take (length xs - n + 1) (map (take n) (tails xs))

--    ghci> length (segmentos1 3 [1..30000])
--    29998
--    (2.99 secs, 13998816 bytes)
--    
--    ghci> length (segmentos2 3 [1..30000])
--    29998
--    (0.05 secs, 16941304 bytes)
--    
--    ghci> length (segmentos3 3 [1..30000])
--    29998
--    (0.04 secs, 10375520 bytes)
--    
--    ghci> length (segmentos2 3 [1..1000000])
--    999998
--    (0.70 secs, 498098336 bytes)
--    
--    ghci> length (segmentos3 3 [1..1000000])
--    999998
--    (0.24 secs, 273979304 bytes)

import Data.List (tails)

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

segmentos1 :: Int -> [a] -> [[a]]

segmentos1 n xs

| length xs < n = []

| otherwise = take n xs : segmentos1 n (tail xs)

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

segmentos2 :: Int -> [a] -> [[a]]

segmentos2 n xs =

takeWhile (\ys -> length ys == n) (map (take n) (tails xs))

-- 3ª definición:

segmentos3 :: Int -> [a] -> [[a]]

segmentos3 n xs =

take (length xs - n + 1) (map (take n) (tails xs))

-- ghci> length (segmentos1 3 [1..30000])

-- 29998

-- (2.99 secs, 13998816 bytes)

-- ghci> length (segmentos2 3 [1..30000])

-- 29998

-- (0.05 secs, 16941304 bytes)

-- ghci> length (segmentos3 3 [1..30000])

-- 29998

-- (0.04 secs, 10375520 bytes)

-- ghci> length (segmentos2 3 [1..1000000])

-- 999998

-- (0.70 secs, 498098336 bytes)

-- ghci> length (segmentos3 3 [1..1000000])

-- 999998

-- (0.24 secs, 273979304 bytes)

Suma de una lista de vectores

PorJosé A. Alonso 19-enero-201530-noviembre-2015

Definir la función

   sumaVec :: Num a => [[a]] -> [a]

1	sumaVec :: Num a => [[a]] -> [a]

tal que (sumaVec xss) es la suma de los vectores de xss. Por ejemplo,

   sumaVec [[4,7,3],[3,1,4],[2,2,5]]  ==  [9,10,12]
   sumaVec [[4,7],[3,3],[1,4],[2,5]]  ==  [10,19]

1 2	sumaVec [[4,7,3],[3,1,4],[2,2,5]] == [9,10,12] sumaVec [[4,7],[3,3],[1,4],[2,5]] == [10,19]

Soluciones

import Data.List (transpose)
import Data.Array (listArray,(!))

-- 1ª definición (por recursión):
sumaVec1 :: Num a => [[a]] -> [a]
sumaVec1 []          = []
sumaVec1 [xs]        = xs
sumaVec1 (xs:ys:zss) = suma xs (sumaVec1 (ys:zss))

-- (suma xs ys) es la suma de los vectores xs e ys. Por ejemplo,
--    suma [4,7,3] [1,2,5]  == [5,9,8]
suma :: Num a => [a] -> [a] -> [a]
suma [] []         = []
suma (x:xs) (y:ys) = x+y : suma xs ys

-- 2ª definición (por recursión con zipWith): 
sumaVec2 :: Num a => [[a]] -> [a]
sumaVec2 []       = []
sumaVec2 [xs]     = xs
sumaVec2 (xs:xss) = zipWith (+) xs (sumaVec2 xss)

-- 3ª definición (por plegado)
sumaVec3 :: Num a => [[a]] -> [a]
sumaVec3 = foldr1 (zipWith (+))

-- 4ª definición (con map y transpose):
sumaVec4 :: Num a => [[a]] -> [a]
sumaVec4 = map sum . transpose 

-- 5ª definición (con array)
-- =========================

sumaVec5 :: Num a => [[a]] -> [a]
sumaVec5 xss = [sum [p!(i,j) | i <- [1..m]] | j <- [1..n]] 
    where m = length xss
          n = length (head xss)
          p = listArray ((1,1),(m,n)) (concat xss)

import Data.List (transpose)

import Data.Array (listArray,(!))

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

sumaVec1 :: Num a => [[a]] -> [a]

sumaVec1 [] = []

sumaVec1 [xs] = xs

sumaVec1 (xs:ys:zss) = suma xs (sumaVec1 (ys:zss))

-- (suma xs ys) es la suma de los vectores xs e ys. Por ejemplo,

-- suma [4,7,3] [1,2,5] == [5,9,8]

suma :: Num a => [a] -> [a] -> [a]

suma [] [] = []

suma (x:xs) (y:ys) = x+y : suma xs ys

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

sumaVec2 :: Num a => [[a]] -> [a]

sumaVec2 [] = []

sumaVec2 [xs] = xs

sumaVec2 (xs:xss) = zipWith (+) xs (sumaVec2 xss)

-- 3ª definición (por plegado)

sumaVec3 :: Num a => [[a]] -> [a]

sumaVec3 = foldr1 (zipWith (+))

-- 4ª definición (con map y transpose):

sumaVec4 :: Num a => [[a]] -> [a]

sumaVec4 = map sum . transpose

-- 5ª definición (con array)

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

sumaVec5 :: Num a => [[a]] -> [a]

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

where m = length xss

n = length (head xss)

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

Ordenación según una función

PorJosé A. Alonso 16-enero-201526-abril-2015

Definir la función

   ordenaSegun :: Ord b => (a -> b) -> [a] -> [a]

1	ordenaSegun :: Ord b => (a -> b) -> [a] -> [a]

tal que (ordenaSegun f xs) es la lista obtenida ordenando los elementos de xs según sus valores mediante la función f. Por ejemplo,

   ordenaSegun abs [-3,2,5,-2]                           ==  [2,-2,-3,5]
   ordenaSegun abs [-3,-2,5,2]                           ==  [-2,2,-3,5]
   ordenaSegun length ["pq","x","mn"]                    ==  ["x","pq","mn"]
   [g 0 | g <- ordenaSegun (\f -> f 4) [(+5),(+2),(+3)]] == [2,3,5]

ordenaSegun abs [-3,2,5,-2] == [2,-2,-3,5]

ordenaSegun abs [-3,-2,5,2] == [-2,2,-3,5]

ordenaSegun length ["pq","x","mn"] == ["x","pq","mn"]

[g 0 | g <- ordenaSegun (\f -> f 4) [(+5),(+2),(+3)]] == [2,3,5]

Comprobar con QuickCheck que (ordenaSegun id) es equivalente a sort.

Soluciones

import Data.List (sort, sortBy)
import Data.Ord (comparing)
import Test.QuickCheck

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

ordenaSegun :: Ord b => (a -> b) -> [a] -> [a]
ordenaSegun _ []  = []
ordenaSegun f (x:xs) = insertaSegun f x (ordenaSegun f xs)

insertaSegun :: Ord b => (a -> b) -> a -> [a] -> [a]
insertaSegun _ x [] = [x]
insertaSegun f x (y:ys) | f x <= f y = x : y : ys
                        | otherwise  = y : insertaSegun f x ys

-- 2ª definición
-- =============

ordenaSegun2 :: Ord b => (a -> b) -> [a] -> [a]
ordenaSegun2 f xs = [xs!!i | (_,i) <- sort (zip [f x | x <- xs] [0..])]

-- 3ª definición
-- =============

ordenaSegun3 :: Ord b => (a -> b) -> [a] -> [a]
ordenaSegun3 f xs = map ((xs!!) . snd) (sort (zip (map f xs) [0..]))

-- 4ª definición
-- =============

ordenaSegun4 :: Ord b => (a -> b) -> [a] -> [a]
ordenaSegun4 = sortBy . comparing

-- La propiedad es
prop_ordenaSegun :: Ord a => [a] -> Bool
prop_ordenaSegun xs =
    ordenaSegun id xs == sort xs

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

import Data.List (sort, sortBy)

import Data.Ord (comparing)

import Test.QuickCheck

-- 1ª definición

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

ordenaSegun :: Ord b => (a -> b) -> [a] -> [a]

ordenaSegun _ [] = []

ordenaSegun f (x:xs) = insertaSegun f x (ordenaSegun f xs)

insertaSegun :: Ord b => (a -> b) -> a -> [a] -> [a]

insertaSegun _ x [] = [x]

insertaSegun f x (y:ys) | f x <= f y = x : y : ys

| otherwise = y : insertaSegun f x ys

-- 2ª definición

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

ordenaSegun2 :: Ord b => (a -> b) -> [a] -> [a]

ordenaSegun2 f xs = [xs!!i | (_,i) <- sort (zip [f x | x <- xs] [0..])]

-- 3ª definición

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

ordenaSegun3 :: Ord b => (a -> b) -> [a] -> [a]

ordenaSegun3 f xs = map ((xs!!) . snd) (sort (zip (map f xs) [0..]))

-- 4ª definición

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

ordenaSegun4 :: Ord b => (a -> b) -> [a] -> [a]

ordenaSegun4 = sortBy . comparing

-- La propiedad es

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

prop_ordenaSegun xs =

ordenaSegun id xs == sort xs

-- La comprobación es

-- ghci> quickCheck prop_ordenaSegun

-- +++ OK, passed 100 tests.

Máxima suma de los segmentos

PorJosé A. Alonso 13-enero-201525-abril-2021

Un segmento de una lista xs es una sublista de xs formada por elementos consecutivos en la lista. El problema de la máxima suma de segmentos consiste en dada una lista de números enteros calcular el máximo de las sumas de todos los segmentos de la lista. Por ejemplo, para la lista [-1,2,-3,5,-2,1,3,-2,-2,-3,6] la máxima suma de segmentos es 7 que es la suma del segmento [5,-2,1,3] y para la lista [-1,-2,-3] es 0 que es la suma de la lista vacía.

Definir la función

   mss :: [Integer] -> Integer

1	mss :: [Integer] -> Integer

tal que (mss xs) es la máxima suma de los segmentos de xs. Por ejemplo,

   mss [-1,2,-3,5,-2,1,3,-2,-2,-3,6]  ==  7
   mss [-1,-2,-3]                     ==  0
   mss [1..500]                       ==  125250
   mss [1..1000]                      ==  500500
   mss [-500..3]                      ==  6
   mss [-1000..3]                     ==  6

mss [-1,2,-3,5,-2,1,3,-2,-2,-3,6] == 7

mss [-1,-2,-3] == 0

mss [1..500] == 125250

mss [1..1000] == 500500

mss [-500..3] == 6

mss [-1000..3] == 6

Soluciones

import Data.List (inits,tails)

-- 1ª solución
mss :: [Integer] -> Integer
mss = maximum . map sum . segmentos

-- (segmentos xs) es la lista de los segmentos de xs. Por ejemplo,
--    ghci> segmentos "abc"
--    ["","a","ab","abc","","b","bc","","c",""]
segmentos :: [a] -> [[a]]
segmentos = concat . map inits . tails

-- 2ª definición:
mss2 :: [Integer] -> Integer
mss2 = maximum . map (maximum . scanl (+) 0) . tails

-- 3ª definición:
mss3 :: [Integer] -> Integer
mss3 = maximum . map sum . concatMap tails . inits 

-- 4ª definición
mss4 :: [Integer] -> Integer
mss4  = fst . foldr (\x (b,a) -> (max (a+x) b, max 0 (a+x))) (0,0) 

-- 5ª definición (con scanl):
mss5 :: [Integer] -> Integer
mss5 = maximum . scanl (\a x -> max 0 a + x) 0

-- Comparación de eficiencia
-- =========================

--    ghci> mss [1..500]
--    125250
--    (7.52 secs, 2022130824 bytes)
--    
--    ghci> mss2 [1..500]
--    125250
--    (0.01 secs, 10474956 bytes)
--    
--    ghci> mss3 [1..500]
--    125250
--    (0.98 secs, 841862016 bytes)
--    
--    ghci> mss4 [1..500]
--    125250
--    (0.01 secs, 552252 bytes)
--    
--    ghci> mss2 [1..1000]
--    500500
--    (0.06 secs, 54575712 bytes)
--    
--    ghci> mss3 [1..1000]
--    500500
--    (7.87 secs, 7061347900 bytes)
--
--    ghci> mss4 [1..1000]
--    500500
--    (0.01 secs, 549700 bytes)
--    
--    ghci> mss2 [1..2000]
--    2001000
--    (0.29 secs, 216424336 bytes)
--    
--    ghci> mss2 [1..5000]
--    12502500
--    (2.37 secs, 1356384840 bytes)
--    
--    ghci> mss4 [1..5000]
--    12502500
--    (0.02 secs, 1913548 bytes)
--
--    ghci> mss5 [1..5000]
--    12502500
--    (0.01 secs, 2886360 bytes)

import Data.List (inits,tails)

-- 1ª solución

mss :: [Integer] -> Integer

mss = maximum . map sum . segmentos

-- (segmentos xs) es la lista de los segmentos de xs. Por ejemplo,

-- ghci> segmentos "abc"

-- ["","a","ab","abc","","b","bc","","c",""]

segmentos :: [a] -> [[a]]

segmentos = concat . map inits . tails

-- 2ª definición:

mss2 :: [Integer] -> Integer

mss2 = maximum . map (maximum . scanl (+) 0) . tails

-- 3ª definición:

mss3 :: [Integer] -> Integer

mss3 = maximum . map sum . concatMap tails . inits

-- 4ª definición

mss4 :: [Integer] -> Integer

mss4 = fst . foldr (\x (b,a) -> (max (a+x) b, max 0 (a+x))) (0,0)

-- 5ª definición (con scanl):

mss5 :: [Integer] -> Integer

mss5 = maximum . scanl (\a x -> max 0 a + x) 0

-- Comparación de eficiencia

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

-- ghci> mss [1..500]

-- 125250

-- (7.52 secs, 2022130824 bytes)

-- ghci> mss2 [1..500]

-- 125250

-- (0.01 secs, 10474956 bytes)

-- ghci> mss3 [1..500]

-- 125250

-- (0.98 secs, 841862016 bytes)

-- ghci> mss4 [1..500]

-- 125250

-- (0.01 secs, 552252 bytes)

-- ghci> mss2 [1..1000]

-- 500500

-- (0.06 secs, 54575712 bytes)

-- ghci> mss3 [1..1000]

-- 500500

-- (7.87 secs, 7061347900 bytes)

-- ghci> mss4 [1..1000]

-- 500500

-- (0.01 secs, 549700 bytes)

-- ghci> mss2 [1..2000]

-- 2001000

-- (0.29 secs, 216424336 bytes)

-- ghci> mss2 [1..5000]

-- 12502500

-- (2.37 secs, 1356384840 bytes)

-- ghci> mss4 [1..5000]

-- 12502500

-- (0.02 secs, 1913548 bytes)

-- ghci> mss5 [1..5000]

-- 12502500

-- (0.01 secs, 2886360 bytes)

Referencias

El ejercicio está basado en la función mss del libro de Bird Thinking functionally with Haskell (página 127).
Las soluciones 3ª y 4ª las publicó josejuan aquí

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.

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.

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"

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Referencias

Soluciones

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Entradas recientes

Buscar

Correo electrónico