Medio – Página 13

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)

Máximos locales de una matriz

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

Un elemento de una matriz es un máximo local si es mayor que todos sus vecinos. Por ejemplo, en la matriz

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

[[1,0,0,8],

[0,2,0,3],

[0,0,0,5],

[3,5,7,6],

[1,2,3,4]]

los máximos locales son 8 (en la posición (1,4)), 2 (en la posición (2,2)) y 7 (en la posición (4,3)).

Definimos el tipo de las matrices, mediante

   type Matriz a = Array (Int,Int) Int

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

y el ejemplo anterior por

   ej1 :: Matriz Int
   ej1 = listArray ((1,1),(5,4)) (concat [[1,0,0,8],
                                          [0,2,0,3],
                                          [0,0,0,5],
                                          [3,5,7,6],
                                          [1,2,3,4]])

ej1 :: Matriz Int

ej1 = listArray ((1,1),(5,4)) (concat [[1,0,0,8],

[0,2,0,3],

[0,0,0,5],

[3,5,7,6],

[1,2,3,4]])

Definir la función

   maximosLocales :: Matriz Int -> [((Int,Int),Int)]

1	maximosLocales :: Matriz Int -> [((Int,Int),Int)]

tal que (maximosLocales p) es la lista de las posiciones en las que hay un máximo local, con el valor correspondiente. Por ejemplo,

   maximosLocales ej1 == [((1,4),8),((2,2),2),((4,3),7)]

1	maximosLocales ej1 == [((1,4),8),((2,2),2),((4,3),7)]

Soluciones

import Data.Array

type Matriz a = Array (Int,Int) a

ej1 :: Matriz Int
ej1 = listArray ((1,1),(5,4)) (concat [[1,0,0,8],
                                       [0,2,0,3],
                                       [0,0,0,5],
                                       [3,5,7,6],
                                       [1,2,3,4]])

maximosLocales :: Matriz Int -> [((Int,Int),Int)]
maximosLocales p = 
    [((i,j),p!(i,j)) | (i,j) <- indices p,
               and [p!(a,b) < p!(i,j) | (a,b) <- vecinos (i,j)]] 
    where (_,(m,n)) = bounds p
          vecinos (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.Array

type Matriz a = Array (Int,Int) a

ej1 :: Matriz Int

ej1 = listArray ((1,1),(5,4)) (concat [[1,0,0,8],

[0,2,0,3],

[0,0,0,5],

[3,5,7,6],

[1,2,3,4]])

maximosLocales :: Matriz Int -> [((Int,Int),Int)]

maximosLocales p =

[((i,j),p!(i,j)) | (i,j) <- indices p,

and [p!(a,b) < p!(i,j) | (a,b) <- vecinos (i,j)]]

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

vecinos (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)]

Árboles con todas sus ramas con algún elemento que cumple una propiedad

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

En lógica temporal, la expresión AFp significa que en algún momento en el futuro se cumple la propiedad p. Trasladado a su interpretación en forma de árbol lo que quiere decir es que en todas las ramas (desde la raíz hasta una hoja) hay un nodo que cumple la propiedad p.

Consideramos el siguiente tipo algebraico de los árboles binarios:

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

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving (Show,Eq)

y el siguiente árbol

   a1 :: Arbol Int
   a1 = N 9 (N 3 (H 2) (N 4 (H 1) (H 5))) (H 8)

1 2	a1 :: Arbol Int a1 = N 9 (N 3 (H 2) (N 4 (H 1) (H 5))) (H 8)

En este árbol se cumple (AF par); es decir, en todas las ramas hay un número par; pero no se cumple (AF primo); es decir, hay ramas en las que no hay ningún número primo. Donde una rama es la secuencia de nodos desde el nodo inicial o raíz hasta una hoja.

Definir la función

   propiedadAF :: (a -> Bool) -> Arbol a -> Bool

1	propiedadAF :: (a -> Bool) -> Arbol a -> Bool

tal que (propiedadAF p a) se verifica si se cumple (AF p) en el árbol a; es decir, si en todas las ramas hay un nodo (interno u hoja) que cumple la propiedad p. Por ejemplo

   propiedadAF even a1  ==  True
   propiedadAF (<7) a1  ==  False

1 2	propiedadAF even a1 == True propiedadAF (<7) a1 == False

Soluciones

[schedule expon=’2015-03-26′ expat=»06:00″]

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

a1 :: Arbol Int
a1 = N 9 (N 3 (H 2) (N 4 (H 1) (H 5))) (H 8)

propiedadAF :: (a -> Bool) -> Arbol a -> Bool
propiedadAF p (H a)     = p a
propiedadAF p (N a i d) = p a || (propiedadAF p i && propiedadAF p d)

data Arbol a = H a

| N a (Arbol a) (Arbol a)

deriving (Show,Eq)

a1 :: Arbol Int

a1 = N 9 (N 3 (H 2) (N 4 (H 1) (H 5))) (H 8)

propiedadAF :: (a -> Bool) -> Arbol a -> Bool

propiedadAF p (H a) = p a

propiedadAF p (N a i d) = p a || (propiedadAF p i && propiedadAF p d)

Números como sumas de primos consecutivos

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

En el artículo Integers as a sum of consecutive primes in 2,3,4,.. ways se presentan números que se pueden escribir como sumas de primos consecutivos de varias formas. Por ejemplo, el 41 se puede escribir de dos formas distintas

   41 =  2 +  3 +  5 + 7 + 11 + 13
   41 = 11 + 13 + 17

1 2	41 = 2 + 3 + 5 + 7 + 11 + 13 41 = 11 + 13 + 17

el 240 se puede escribir de tres formas

   240 =  17 +  19 + 23 + 29 + 31 + 37 + 41 + 43
   240 =  53 +  59 + 61 + 67
   240 = 113 + 127

240 = 17 + 19 + 23 + 29 + 31 + 37 + 41 + 43

240 = 53 + 59 + 61 + 67

240 = 113 + 127

y el 311 se puede escribir de 4 formas

   311 =  11 +  13 +  17 + 19 + 23 + 29 + 31 + 37 + 41 + 43 + 47
   311 =  31 +  37 +  41 + 43 + 47 + 53 + 59
   311 =  53 +  59 +  61 + 67 + 71
   311 = 101 + 103 + 107

311 = 11 + 13 + 17 + 19 + 23 + 29 + 31 + 37 + 41 + 43 + 47

311 = 31 + 37 + 41 + 43 + 47 + 53 + 59

311 = 53 + 59 + 61 + 67 + 71

311 = 101 + 103 + 107

Definir la función

   sumas :: Integer -> [[Integer]]

1	sumas :: Integer -> [[Integer]]

tal que (sumas x) es la lista de las formas de escribir x como suma de dos o más números primos consecutivos. Por ejemplo,

   ghci> sumas 41
   [[2,3,5,7,11,13],[11,13,17]]
   ghci> sumas 240
   [[17,19,23,29,31,37,41,43],[53,59,61,67],[113,127]]
   ghci> sumas 311
   [[11,13,17,19,23,29,31,37,41,43,47],[31,37,41,43,47,53,59],
    [53,59,61,67,71],[101,103,107]]
   ghci> maximum [length (sumas n) | n <- [1..600]]
   4

ghci> sumas 41

[[2,3,5,7,11,13],[11,13,17]]

ghci> sumas 240

[[17,19,23,29,31,37,41,43],[53,59,61,67],[113,127]]

ghci> sumas 311

[[11,13,17,19,23,29,31,37,41,43,47],[31,37,41,43,47,53,59],

[53,59,61,67,71],[101,103,107]]

ghci> maximum [length (sumas n) | n <- [1..600]]

Soluciones

import Data.Numbers.Primes (primes)
import Data.List (span)

sumas :: Integer -> [[Integer]]
sumas x = [ys | n <- takeWhile (< x) primes, 
                let ys = sumaDesde x n,
                not (null ys)]

-- (sumaDesde x n) es la lista de al menos dos números primos
-- consecutivos a partir del número primo n cuya suma es x, si existen y
-- la lista vacía en caso contrario. Por ejemplo,
--    sumaDesde 15 3  ==  [3,5,7]
--    sumaDesde  7 3  ==  []
sumaDesde :: Integer -> Integer -> [Integer]
sumaDesde x n | x == y    = take (1 + length us) ys
              | otherwise = []
    where ys       = dropWhile (<n) primes
          (us,y:_) = span (<x) (scanl1 (+) ys)

import Data.Numbers.Primes (primes)

import Data.List (span)

sumas :: Integer -> [[Integer]]

sumas x = [ys | n <- takeWhile (< x) primes,

let ys = sumaDesde x n,

not (null ys)]

-- (sumaDesde x n) es la lista de al menos dos números primos

-- consecutivos a partir del número primo n cuya suma es x, si existen y

-- la lista vacía en caso contrario. Por ejemplo,

-- sumaDesde 15 3 == [3,5,7]

-- sumaDesde 7 3 == []

sumaDesde :: Integer -> Integer -> [Integer]

sumaDesde x n | x == y = take (1 + length us) ys

| otherwise = []

where ys = dropWhile (<n) primes

(us,y:_) = span (<x) (scanl1 (+) ys)

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]

Listas con los ceros emparejados

PorJosé A. Alonso 4-marzo-201511-marzo-2015

Sea S un conjunto de números. Las listas de ceros emparejados de S son las listas formadas con los elementos de S y en las cuales los ceros aparecen en sublistas de longitud par. Por ejemplo, si S = {0,1,2} entonces [1], [2], [2,1], [2,0,0,2,0,0,1] y [0,0,0,0,1,2] son listas de ceros emparejados de S; pero [0,0,0,2,1,0,0] y [0,0,1,0,1] no lo son.

Definir las funciones

   cerosEmparejados  :: Integer -> Integer -> [[Integer]]
   nCerosEmparejados :: Integer -> Integer -> Integer

1 2	cerosEmparejados :: Integer -> Integer -> [[Integer]] nCerosEmparejados :: Integer -> Integer -> Integer

tales que
+ (cerosEmparejados m n) es la lista de las listas de longitud n de ceros emparejados con los números 0, 1, 2,…, m. Por ejemplo,

     ghci> cerosEmparejados 2 0
     [[]]
     ghci> cerosEmparejados 2 1
     [[1],[2]]
     ghci> cerosEmparejados 3 1
     [[1],[2],[3]]
     ghci> cerosEmparejados 2 2
     [[1,1],[1,2],[2,1],[2,2],[0,0]]
     ghci> cerosEmparejados 2 3
     [[1,1,1],[1,1,2],[1,2,1],[1,2,2],[1,0,0],[2,1,1],[2,1,2],
      [2,2,1],[2,2,2],[2,0,0],[0,0,1],[0,0,2]]
     ghci> cerosEmparejados 2 4
     [[1,1,1,1],[1,1,1,2],[1,1,2,1],[1,1,2,2],[1,1,0,0],[1,2,1,1],
      [1,2,1,2],[1,2,2,1],[1,2,2,2],[1,2,0,0],[1,0,0,1],[1,0,0,2],
      [2,1,1,1],[2,1,1,2],[2,1,2,1],[2,1,2,2],[2,1,0,0],[2,2,1,1],
      [2,2,1,2],[2,2,2,1],[2,2,2,2],[2,2,0,0],[2,0,0,1],[2,0,0,2],
      [0,0,1,1],[0,0,1,2],[0,0,2,1],[0,0,2,2],[0,0,0,0]]

ghci> cerosEmparejados 2 0

[[]]

ghci> cerosEmparejados 2 1

[[1],[2]]

ghci> cerosEmparejados 3 1

[[1],[2],[3]]

ghci> cerosEmparejados 2 2

[[1,1],[1,2],[2,1],[2,2],[0,0]]

ghci> cerosEmparejados 2 3

[[1,1,1],[1,1,2],[1,2,1],[1,2,2],[1,0,0],[2,1,1],[2,1,2],

[2,2,1],[2,2,2],[2,0,0],[0,0,1],[0,0,2]]

ghci> cerosEmparejados 2 4

[[1,1,1,1],[1,1,1,2],[1,1,2,1],[1,1,2,2],[1,1,0,0],[1,2,1,1],

[1,2,1,2],[1,2,2,1],[1,2,2,2],[1,2,0,0],[1,0,0,1],[1,0,0,2],

[2,1,1,1],[2,1,1,2],[2,1,2,1],[2,1,2,2],[2,1,0,0],[2,2,1,1],

[2,2,1,2],[2,2,2,1],[2,2,2,2],[2,2,0,0],[2,0,0,1],[2,0,0,2],

[0,0,1,1],[0,0,1,2],[0,0,2,1],[0,0,2,2],[0,0,0,0]]

(nCerosEmparejados m n) es el número de listas de longitud n de ceros emparejados con los números 0, 1, 2,…, m. Por ejemplo,

     nCerosEmparejados 2 2   ==  5
     nCerosEmparejados 2 3   ==  12
     nCerosEmparejados 2 4   ==  29
     nCerosEmparejados 9 27  ==  79707842493701635611689499

nCerosEmparejados 2 2 == 5

nCerosEmparejados 2 3 == 12

nCerosEmparejados 2 4 == 29

nCerosEmparejados 9 27 == 79707842493701635611689499

Soluciones

import Data.List (genericIndex)
import Data.List (genericLength) 

cerosEmparejados :: Integer -> Integer -> [[Integer]]
cerosEmparejados m 0 = [[]]
cerosEmparejados m 1 = [[k] | k <- [1..m]]
cerosEmparejados m n = 
    [x:ys | x <- [1..m], ys <- cerosEmparejados m (n-1)] ++
    [0:0:ys | ys <- cerosEmparejados m (n-2)]

-- 1ª definición de nCerosEmparejados: 
nCerosEmparejados1 :: Integer -> Integer -> Integer
nCerosEmparejados1 m n = fromIntegral (length (cerosEmparejados m n))

-- 2ª definición de nCerosEmparejados: 
nCerosEmparejados2 :: Integer -> Integer -> Integer
nCerosEmparejados2 _ 0 = 1
nCerosEmparejados2 m 1 = m
nCerosEmparejados2 m n = 
    m * nCerosEmparejados2 m (n-1) + nCerosEmparejados2 m (n-2)

-- 3ª definición de nCerosEmparejados: 
nCerosEmparejados3 :: Integer -> Integer -> Integer
nCerosEmparejados3 m n = aux `genericIndex` n
    where aux = 1 : m : zipWith (\x y -> x+m*y) aux (tail aux)

-- Comparación de eficiencia
--    ghci> nCerosEmparejados1 9 7
--    5144589
--    (22.30 secs, 6556279384 bytes)
--    ghci> nCerosEmparejados2 9 7
--    5144589
--    (0.01 secs, 515464 bytes)
--    ghci> nCerosEmparejados3 9 7
--    5144589
--    (0.01 secs, 518104 bytes)
--
--    ghci> nCerosEmparejados2 9 33
--    45556060883025783396845717812863
--    (21.59 secs, 2676070480 bytes)
--    ghci> nCerosEmparejados3 9 33
--    45556060883025783396845717812863
--    (0.00 secs, 1017240 bytes)

import Data.List (genericIndex)

import Data.List (genericLength)

cerosEmparejados :: Integer -> Integer -> [[Integer]]

cerosEmparejados m 0 = [[]]

cerosEmparejados m 1 = [[k] | k <- [1..m]]

cerosEmparejados m n =

[x:ys | x <- [1..m], ys <- cerosEmparejados m (n-1)] ++

[0:0:ys | ys <- cerosEmparejados m (n-2)]

-- 1ª definición de nCerosEmparejados:

nCerosEmparejados1 :: Integer -> Integer -> Integer

nCerosEmparejados1 m n = fromIntegral (length (cerosEmparejados m n))

-- 2ª definición de nCerosEmparejados:

nCerosEmparejados2 :: Integer -> Integer -> Integer

nCerosEmparejados2 _ 0 = 1

nCerosEmparejados2 m 1 = m

nCerosEmparejados2 m n =

m * nCerosEmparejados2 m (n-1) + nCerosEmparejados2 m (n-2)

-- 3ª definición de nCerosEmparejados:

nCerosEmparejados3 :: Integer -> Integer -> Integer

nCerosEmparejados3 m n = aux `genericIndex` n

where aux = 1 : m : zipWith (\x y -> x+m*y) aux (tail aux)

-- Comparación de eficiencia

-- ghci> nCerosEmparejados1 9 7

-- 5144589

-- (22.30 secs, 6556279384 bytes)

-- ghci> nCerosEmparejados2 9 7

-- 5144589

-- (0.01 secs, 515464 bytes)

-- ghci> nCerosEmparejados3 9 7

-- 5144589

-- (0.01 secs, 518104 bytes)

-- ghci> nCerosEmparejados2 9 33

-- 45556060883025783396845717812863

-- (21.59 secs, 2676070480 bytes)

-- ghci> nCerosEmparejados3 9 33

-- 45556060883025783396845717812863

-- (0.00 secs, 1017240 bytes)

Diagonales secundarias de una matriz

PorJosé A. Alonso 20-febrero-201526-abril-2015

Definir la función

   diagonalesSecundarias :: Matriz a -> [[a]]

1	diagonalesSecundarias :: Matriz a -> [[a]]

tal que (diagonalesSecundarias p) es la lista de las diagonales secundarias de p. Por ejemplo, para la matriz

   1  2  3  4
   5  6  7  8
   9 10 11 12

1 2 3 4

5 6 7 8

9 10 11 12

la lista de sus diagonales secundarias es

   [[1],[2,5],[3,6,9],[4,7,10],[8,11],[12]]

1	[[1],[2,5],[3,6,9],[4,7,10],[8,11],[12]]

En Haskell,

   ghci> diagonalesSecundarias (listArray ((1,1),(3,4)) [1..12])
   [[1],[2,5],[3,6,9],[4,7,10],[8,11],[12]]

1 2	ghci> diagonalesSecundarias (listArray ((1,1),(3,4)) [1..12]) [[1],[2,5],[3,6,9],[4,7,10],[8,11],[12]]

Soluciones

import Data.Array

type Matriz a = Array (Int,Int) a

diagonalesSecundarias :: Matriz a -> [[a]]
diagonalesSecundarias p = 
    [[p!ij1 | ij1 <- extension ij] | ij <- iniciales]
    where (_,(m,n)) = bounds p
          iniciales = [(1,j) | j <- [1..n]] ++ [(i,n) | i <- [2..m]] 
          extension (i,j) = [(i+k,j-k) | k <- [0..min (j-1) (m-i)]]

import Data.Array

type Matriz a = Array (Int,Int) a

diagonalesSecundarias :: Matriz a -> [[a]]

diagonalesSecundarias p =

[[p!ij1 | ij1 <- extension ij] | ij <- iniciales]

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

iniciales = [(1,j) | j <- [1..n]] ++ [(i,n) | i <- [2..m]]

extension (i,j) = [(i+k,j-k) | k <- [0..min (j-1) (m-i)]]

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

...

Números polidivisibles

PorJosé A. Alonso 30-enero-20156-febrero-2015

Introducción

Un número natural es polidivisible si cumple las siguientes condiciones:

El número formado por sus dos primeros dígitos es divisible por 2.
El número formado por sus tres primeros dígitos es divisible por 3.
El número formado por sus cuatros primeros dígitos es divisible por 4.
etcétera.

Por ejemplo, el número 345654 es un número polidivisible ya que

34 es divisible por 2,
345 es divisible por 3,
3456 es divisible por 4,
34565 es divisible por 5 y
345654 es divisible por 6.

pero 123456 no lo es, porque 1234 no es divisible por 4.

Enunciado

Definir las funciones

  polidivisibles :: [Integer]
  polidivisiblesN :: Integer -> [Integer]

1 2	polidivisibles :: [Integer] polidivisiblesN :: Integer -> [Integer]

tales que

polidivisible es la sucesión cuyos elementos son los números polidivisibles. Por ejemplo,

     ghci> take 20 polidivisibles
     [1,2,3,4,5,6,7,8,9,10,12,14,16,18,20,22,24,26,28,30]
     ghci> take 10 (dropWhile (<=100) polidivisibles)
     [102,105,108,120,123,126,129,141,144,147]

ghci> take 20 polidivisibles

[1,2,3,4,5,6,7,8,9,10,12,14,16,18,20,22,24,26,28,30]

ghci> take 10 (dropWhile (<=100) polidivisibles)

[102,105,108,120,123,126,129,141,144,147]

(polidivisiblesN k) es la lista de los números polidivisibles con k dígitos. Por ejemplo,

     ghci> polidivisiblesN 2
     [10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48,
      50,52,54,56,58,60,62,64,66,68,70,72,74,76,78,80,82,84,86,88,
      90,92,94,96,98]

ghci> polidivisiblesN 2

[10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48,

50,52,54,56,58,60,62,64,66,68,70,72,74,76,78,80,82,84,86,88,

90,92,94,96,98]

Comprobar que, para n entre 1 y 5, la cantidad de números polidivisibles de n dígitos es 9*10^(n-1)/n!.

Soluciones

polidivisibles :: [Integer]
polidivisibles = [n | n <- [1..], esPolidivisible n]

-- (esPolidivisible n) se verifica si n es polidivisible. Por ejemplo, 
--    esPolidivisible 345654  ==  True
--    esPolidivisible 123456  ==  False
esPolidivisible :: Integer -> Bool
esPolidivisible n = 
    and [(n `div` 10^(m-k)) `mod` k == 0 | k <- [2..m]] 
    where m = fromIntegral (length (show n))

-- (polidivisiblesN n) es la lista de los números polidivisibles de n
-- dígitos. Por ejemplo, 
--    take 6 (polidivisiblesN 3)  ==  [102,105,108,120,123,126]
--    take 6 (polidivisiblesN 5)  ==  [10200,10205,10240,10245,10280,10285]
polidivisiblesN :: Integer -> [Integer]
polidivisiblesN n = 
    takeWhile (<=10^n-1) (dropWhile (<10^(n-1)) polidivisibles)

-- (conjetura k) se verifica si la cantidad de números polidivisibles de
-- k dígitos es 9*10^(k-1)/k!. 
conjetura :: Integer -> Bool
conjetura k = 
    fromIntegral (length (polidivisiblesN k)) == 9*10^(k-1) `div` factorial k
    where factorial n = product [1..n]

-- La comprobación de la conjetura para k entre 1 y 5 es
--    ghci> all conjetura [1..5]
--    True

polidivisibles :: [Integer]

polidivisibles = [n | n <- [1..], esPolidivisible n]

-- (esPolidivisible n) se verifica si n es polidivisible. Por ejemplo,

-- esPolidivisible 345654 == True

-- esPolidivisible 123456 == False

esPolidivisible :: Integer -> Bool

esPolidivisible n =

and [(n `div` 10^(m-k)) `mod` k == 0 | k <- [2..m]]

where m = fromIntegral (length (show n))

-- (polidivisiblesN n) es la lista de los números polidivisibles de n

-- dígitos. Por ejemplo,

-- take 6 (polidivisiblesN 3) == [102,105,108,120,123,126]

-- take 6 (polidivisiblesN 5) == [10200,10205,10240,10245,10280,10285]

polidivisiblesN :: Integer -> [Integer]

polidivisiblesN n =

takeWhile (<=10^n-1) (dropWhile (<10^(n-1)) polidivisibles)

-- (conjetura k) se verifica si la cantidad de números polidivisibles de

-- k dígitos es 9*10^(k-1)/k!.

conjetura :: Integer -> Bool

conjetura k =

fromIntegral (length (polidivisiblesN k)) == 9*10^(k-1) `div` factorial k

where factorial n = product [1..n]

-- La comprobación de la conjetura para k entre 1 y 5 es

-- ghci> all conjetura [1..5]

-- True

División según una propiedad

PorJosé A. Alonso 28-enero-20154-febrero-2015

Enunciado

Definir la función

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

1	divideSegun :: (a -> Bool) -> [a] -> [[a]]

tal que (divideSegun p xs) es la lista de los segmentos de xs cuyos elementos no cumplen la propiedad p. Por ejemplo,

   divideSegun even [3,5,2,7,6,8,9,1]  ==  [[3,5],[7],[9,1]]
   divideSegun odd  [3,5,2,7,6,8,9,1]  ==  [[2],[6,8]]

1 2	divideSegun even [3,5,2,7,6,8,9,1] == [[3,5],[7],[9,1]] divideSegun odd [3,5,2,7,6,8,9,1] == [[2],[6,8]]

Comprobar con QuickCheck que, para cualquier lista xs de números enteros, la concatenación de los elementos de (divideSegun even xs) es la lista de los elementos de xs que no son pares.

Soluciones

import Test.QuickCheck

divideSegun :: (a -> Bool) -> [a] -> [[a]]
divideSegun p xs 
    | null ys   = []
    | otherwise = ys : divideSegun p zs
    where (ys,zs) = break p (dropWhile p xs)

-- La propiedad es
prop_divideSegun :: [Int] -> Bool
prop_divideSegun xs =
    concat (divideSegun even xs) == filter (not . even) xs

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

import Test.QuickCheck

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

divideSegun p xs

| null ys = []

| otherwise = ys : divideSegun p zs

where (ys,zs) = break p (dropWhile p xs)

-- La propiedad es

prop_divideSegun :: [Int] -> Bool

prop_divideSegun xs =

concat (divideSegun even xs) == filter (not . even) xs

-- La comprobación es

-- ghci> quickCheck prop_divideSegun

-- +++ OK, passed 100 tests.

Particiones en listas de segmentos

PorJosé A. Alonso 27-enero-20153-febrero-2015

Exercitium

Definir la función

   particiones :: Int -> [a] -> [[[a]]]

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

tal que (particiones n xs) es la lista de listas de n elementos cuya concatenación es xs. Por ejemplo,

   ghci> particiones 2 "abc"
   [["","abc"],["a","bc"],["ab","c"],["abc",""]]
   ghci> particiones 3 "abc"
   [["","","abc"],["","a","bc"],["","ab","c"],["","abc",""],
    ["a","","bc"],["a","b","c"],["a","bc",""],["ab","","c"],
    ["ab","c",""],["abc","",""]]
   ghci> length (particiones 4 "abc")
   20

ghci> particiones 2 "abc"

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

ghci> particiones 3 "abc"

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

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

["ab","c",""],["abc","",""]]

ghci> length (particiones 4 "abc")

Soluciones

particiones :: Int -> [a] -> [[[a]]]
particiones 0 [] = [[]]
particiones 0 xs = []
particiones n xs = [ys:yss | (ys,zs) <- biparticiones xs,
                             yss <- particiones (n-1) zs]

-- (biparticiones xs) es la lista de los pares (xs1,xs2) tales que su
-- concatenación es xs. Por ejemplo, 
--    ghci> biparticiones "abc"
--    [("","abc"),("a","bc"),("ab","c"),("abc","")]
biparticiones :: [a] -> [([a],[a])]
biparticiones []     = [([],[])]
biparticiones (x:xs) = ([],x:xs) :  
                       [(x:xs1,xs2) | (xs1,xs2) <- biparticiones xs]

particiones :: Int -> [a] -> [[[a]]]

particiones 0 [] = [[]]

particiones 0 xs = []

particiones n xs = [ys:yss | (ys,zs) <- biparticiones xs,

yss <- particiones (n-1) zs]

-- (biparticiones xs) es la lista de los pares (xs1,xs2) tales que su

-- concatenación es xs. Por ejemplo,

-- ghci> biparticiones "abc"

-- [("","abc"),("a","bc"),("ab","c"),("abc","")]

biparticiones :: [a] -> [([a],[a])]

biparticiones [] = [([],[])]

biparticiones (x:xs) = ([],x:xs) :

[(x:xs1,xs2) | (xs1,xs2) <- biparticiones xs]

Sustitución de listas

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

Definir la función

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

1	sustituye :: Eq a => [a] -> [a] -> [a] -> [a]

tal que (sustituye xs ys zs) es la lista obtenida sustituyendo las ocurrencias de la lista no vacía xs en zs por ys. Por ejemplo,

   sustituye "as" "_" "las casaderas"   ==  "l_ c_ader_"
   sustituye "as" "es" "las casaderas"  ==  "les cesaderes"
   sustituye "asa" "a" "las casaderas"  ==  "las caderas"
   sustituye "asd" "a" "las casaderas"  ==  "las casaderas"

sustituye "as" "_" "las casaderas" == "l_ c_ader_"

sustituye "as" "es" "las casaderas" == "les cesaderes"

sustituye "asa" "a" "las casaderas" == "las caderas"

sustituye "asd" "a" "las casaderas" == "las casaderas"

Soluciones

import Data.List (isPrefixOf)

sustituye :: Eq a => [a] -> [a] -> [a] -> [a]
sustituye xs ys [] = []
sustituye xs ys (z:zs) 
    | isPrefixOf xs (z:zs) = ys ++ sustituye xs ys (drop n zs)
    | otherwise            = z : sustituye xs ys zs
    where n = length xs - 1

import Data.List (isPrefixOf)

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

sustituye xs ys [] = []

sustituye xs ys (z:zs)

| isPrefixOf xs (z:zs) = ys ++ sustituye xs ys (drop n zs)

| otherwise = z : sustituye xs ys zs

where n = length xs - 1

Triparticiones de una lista

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

Definir la función

   triparticiones :: [a] -> [([a],[a],[a])]

1	triparticiones :: [a] -> [([a],[a],[a])]

tal que (triparticiones xs) es la lista de las ternas (xs1,xs2,xs3) tales que su concatenación es xs. Por ejemplo,

   ghci> triparticiones "abc"
   [("","","abc"),("","a","bc"),("","ab","c"),("","abc",""),
    ("a","","bc"),("a","b","c"),("a","bc",""),("ab","","c"),
    ("ab","c",""),("abc","","")]

ghci> triparticiones "abc"

[("","","abc"),("","a","bc"),("","ab","c"),("","abc",""),

("a","","bc"),("a","b","c"),("a","bc",""),("ab","","c"),

("ab","c",""),("abc","","")]

Comprobar con QuickCheck que, suponiendo que xs es una lista de elementos comparables por igualdad, entonces para cada terna de (triparticiones xs) se cumple que la concatenación de sus elementos es xs.

Soluciones

import Test.QuickCheck

triparticiones :: [a] -> [([a],[a],[a])]
triparticiones xs = [(xs1,xs2,xs3) | (xs1,ys)  <- biparticiones xs,
                                     (xs2,xs3) <- biparticiones ys]

-- (biparticiones xs) es la lista de los pares (xs1,xs2) tales que su
-- concatenación es xs. Por ejemplo, 
--    ghci> biparticiones "abc"
--    [("","abc"),("a","bc"),("ab","c"),("abc","")]
biparticiones :: [a] -> [([a],[a])]
biparticiones []     = [([],[])]
biparticiones (x:xs) = ([],x:xs) :
                       [(x:xs1,xs2) | (xs1,xs2) <- biparticiones xs]

-- La propiedad es
prop_triparticiones :: Eq a => [a] -> Bool
prop_triparticiones xs =
    all (\(xs1,xs2,xs3) -> xs1 ++ xs2 ++ xs3 == xs) (triparticiones xs)

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

import Test.QuickCheck

triparticiones :: [a] -> [([a],[a],[a])]

triparticiones xs = [(xs1,xs2,xs3) | (xs1,ys) <- biparticiones xs,

(xs2,xs3) <- biparticiones ys]

-- (biparticiones xs) es la lista de los pares (xs1,xs2) tales que su

-- concatenación es xs. Por ejemplo,

-- ghci> biparticiones "abc"

-- [("","abc"),("a","bc"),("ab","c"),("abc","")]

biparticiones :: [a] -> [([a],[a])]

biparticiones [] = [([],[])]

biparticiones (x:xs) = ([],x:xs) :

[(x:xs1,xs2) | (xs1,xs2) <- biparticiones xs]

-- La propiedad es

prop_triparticiones :: Eq a => [a] -> Bool

prop_triparticiones xs =

all (\(xs1,xs2,xs3) -> xs1 ++ xs2 ++ xs3 == xs) (triparticiones xs)

-- La comprobación es

-- ghci> quickCheck prop_triparticiones

-- +++ OK, passed 100 tests.

Listas con suma dada

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

Definir la función

   conSuma :: (Eq a, Num a) => [a] -> [[a]] -> [[[a]]]

1	conSuma :: (Eq a, Num a) => [a] -> [[a]] -> [[[a]]]

tal que (conSuma xs yss) es la lista de los vectores de xss cuya suma vectorial es xs. Por ejemplo,

   ghci> conSuma [9,10,12] [[4,7,3],[3,1,4],[5,3,9],[2,2,5]] 
   [[[4,7,3],[5,3,9]],[[4,7,3],[3,1,4],[2,2,5]]]
   ghci> conSuma [9,11,12] [[4,7,3],[3,1,4],[5,3,9],[2,2,5]] 
   []

ghci> conSuma [9,10,12] [[4,7,3],[3,1,4],[5,3,9],[2,2,5]]

[[[4,7,3],[5,3,9]],[[4,7,3],[3,1,4],[2,2,5]]]

ghci> conSuma [9,11,12] [[4,7,3],[3,1,4],[5,3,9],[2,2,5]]

[]

Soluciones

import Data.List (subsequences, transpose)

conSuma :: (Eq a, Num a) => [a] -> [[a]] -> [[[a]]]
conSuma xs yss = [zss | zss <- subsequences yss, suma zss == xs]

-- (suma xss) es la suma de las listas xs. Por ejemplo,
--    suma [[4,7,3],[3,1,4],[2,2,5]]  ==  [9,10,12]
suma :: Num a => [[a]] -> [a]
suma = map sum . transpose

import Data.List (subsequences, transpose)

conSuma :: (Eq a, Num a) => [a] -> [[a]] -> [[[a]]]

conSuma xs yss = [zss | zss <- subsequences yss, suma zss == xs]

-- (suma xss) es la suma de las listas xs. Por ejemplo,

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

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

suma = map sum . transpose

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 pitagóricos

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

Un número pitagórico es un número natural cuyo cuadrado se puede escribir como la suma de los cuadrados de dos números naturales no nulos; es decir, el número natural a es pitagórico si existen dos números naturales b y c distintos de cero tales que a² = b²+c². Por ejemplo, 5 es un número pitagórico ya que 5² = 3²+4² y también lo es 2015 ya que 2015² = 1612²+1209².

Definir la sucesión

    pitagoricos :: [Integer]

1	pitagoricos :: [Integer]

cuyos elementos son los números pitagóricos. Por ejemplo,

   ghci> take 20 pitagoricos
   [5,10,13,15,17,20,25,26,29,30,34,35,37,39,40,41,45,50,51,52]

1 2	ghci> take 20 pitagoricos [5,10,13,15,17,20,25,26,29,30,34,35,37,39,40,41,45,50,51,52]

Calcular la posición de 2015 en la sucesión.

Soluciones

import Test.QuickCheck

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

pitagoricos :: [Integer]
pitagoricos = [n | n <- [1..], esPitagorico n]

-- (esPitagorico n) se verifica si n es pitagórico. Por ejemplo,
--    esPitagorico 5  ==  True
--    esPitagorico 6  ==  False
esPitagorico :: Integer -> Bool
esPitagorico n = not (null (ternasPitagoricas n))

-- (ternasPitagoricas n) es la lista de las ternas (n,a,b) tales que 
-- n² = a²+b² con b < a < n. Por ejemplo,
--    ghci> ternasPitagoricas 5
--    [(5,4,3)]
--    ghci> ternasPitagoricas 2015
--    [(2015,1612,1209),(2015,1736,1023),(2015,1860,775),(2015,1953,496)]
ternasPitagoricas :: Integer -> [(Integer,Integer,Integer)]
ternasPitagoricas n = 
    [(n,a,b) | a <- [1..n-1],
               let b2 = n^2-a^2,
               let b = round (sqrt (fromIntegral b2)),
               b < a,     
               b^2 == b2]

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

pitagoricos2 :: [Integer]
pitagoricos2 = [round (sqrt (fromIntegral a)) | 
                a <- cuadrados,
                let xs = takeWhile (< a) cuadrados,
                any (\b -> a-b `elem` xs) xs]

-- cuadrados es la lista de los cuadrados de los números naturales. Por
-- ejemplo, 
--    take 10 cuadrados  ==  [1,4,9,16,25,36,49,64,81,100]
cuadrados :: [Integer]
cuadrados = [n*n | n <- [1..]]

-- El cálculo de la posición de 2015 es
--    ghci> length (takeWhile (< 2015) pitagoricos)
--    1195

import Test.QuickCheck

-- 1ª definición

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

pitagoricos :: [Integer]

pitagoricos = [n | n <- [1..], esPitagorico n]

-- (esPitagorico n) se verifica si n es pitagórico. Por ejemplo,

-- esPitagorico 5 == True

-- esPitagorico 6 == False

esPitagorico :: Integer -> Bool

esPitagorico n = not (null (ternasPitagoricas n))

-- (ternasPitagoricas n) es la lista de las ternas (n,a,b) tales que

-- n² = a²+b² con b < a < n. Por ejemplo,

-- ghci> ternasPitagoricas 5

-- [(5,4,3)]

-- ghci> ternasPitagoricas 2015

-- [(2015,1612,1209),(2015,1736,1023),(2015,1860,775),(2015,1953,496)]

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

ternasPitagoricas n =

[(n,a,b) | a <- [1..n-1],

let b2 = n^2-a^2,

let b = round (sqrt (fromIntegral b2)),

b < a,

b^2 == b2]

-- 2ª definición

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

pitagoricos2 :: [Integer]

pitagoricos2 = [round (sqrt (fromIntegral a)) |

a <- cuadrados,

let xs = takeWhile (< a) cuadrados,

any (\b -> a-b `elem` xs) xs]

-- cuadrados es la lista de los cuadrados de los números naturales. Por

-- ejemplo,

-- take 10 cuadrados == [1,4,9,16,25,36,49,64,81,100]

cuadrados :: [Integer]

cuadrados = [n*n | n <- [1..]]

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

-- ghci> length (takeWhile (< 2015) pitagoricos)

-- 1195

Varios cuadrados encajados

PorJosé A. Alonso 6-enero-201513-enero-2015

Enunciado

Definir la función

   cuadrados :: Int -> Picture

1	cuadrados :: Int -> Picture

tal que (cuadrados n) dibuje n cuadrados encajados como se muestra en las siguientes figuras:

para n=2
para n=4
para n=10

Nota: Escribir las soluciones usando la siguiente plantilla

import Graphics.Gloss
import System.IO
    
main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  putStr "Introduce el numero de cuadrados [1..10]: "
  n <- readLn
  display (InWindow (show n ++ " cuadrados encajados" ) 
                    (600,600) (20,20)) white (cuadrados n)
    
cuadrados :: Int -> Picture
cuadrados n = undefined

import Graphics.Gloss

import System.IO

main :: IO ()

main = do

hSetBuffering stdout NoBuffering

putStr "Introduce el numero de cuadrados [1..10]: "

n <- readLn

display (InWindow (show n ++ " cuadrados encajados" )

(600,600) (20,20)) white (cuadrados n)

cuadrados :: Int -> Picture

cuadrados n = undefined

Soluciones

import Graphics.Gloss
import System.IO
    
main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  putStr "Introduce el numero de cuadrados [1..10]: "
  n <- readLn
  display (InWindow (show n ++ " cuadrados encajados" ) 
                    (600,600) (20,20)) white (cuadrados n)
    
-- 1ª solución (por comprensión):    
cuadrados :: Int -> Picture
cuadrados n = 
    pictures [scale (r^n) (r^n) $ rotate (g n) $ cuadrado | n <- [0..n-1]]
    where cuadrado        = rectangleWire 500 500
          g n | even n    = 0
              | otherwise = 45
          r               = 1 / sqrt 2

-- 2ª solución (por recursión):    
cuadrados2 :: Int -> Picture
cuadrados2 1 = rectangleWire 500 500
cuadrados2 n = 
    pictures [rectangleWire 500 500,
              rotate 45 $ scale (1/sqrt 2) (1/sqrt 2) (cuadrados2 (n-1))]

import Graphics.Gloss

import System.IO

main :: IO ()

main = do

hSetBuffering stdout NoBuffering

putStr "Introduce el numero de cuadrados [1..10]: "

n <- readLn

display (InWindow (show n ++ " cuadrados encajados" )

(600,600) (20,20)) white (cuadrados n)

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

cuadrados :: Int -> Picture

cuadrados n =

pictures [scale (r^n) (r^n) $ rotate (g n) $ cuadrado | n <- [0..n-1]]

where cuadrado = rectangleWire 500 500

g n | even n = 0

| otherwise = 45

r = 1 / sqrt 2

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

cuadrados2 :: Int -> Picture

cuadrados2 1 = rectangleWire 500 500

cuadrados2 n =

pictures [rectangleWire 500 500,

rotate 45 $ scale (1/sqrt 2) (1/sqrt 2) (cuadrados2 (n-1))]

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

Enumeración de los pares de números naturales

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

Los pares de los números naturales se pueden ordenar por la suma de sus componentes y entre los pares con la misma suma elegir antes al que tiene mayos su primera componente.

Definir la función

   pares :: [(Int,Int)]

1	pares :: [(Int,Int)]

tal que pares es la lista de los pares de números naturales con el orden anterior. por ejemplo,

   ghci> take 10 pares
   [(0,0),(1,0),(0,1),(2,0),(1,1),(0,2),(3,0),(2,1),(1,2),(0,3)]

1 2	ghci> take 10 pares [(0,0),(1,0),(0,1),(2,0),(1,1),(0,2),(3,0),(2,1),(1,2),(0,3)]

Usando la definición de pares, definir la función

   posicion :: (Int,Int) -> Int

1	posicion :: (Int,Int) -> Int

tal que (posicion p) es la posición del par p en la lista pares. Por ejemplo,

   posicion (0,0)  ==  0
   posicion (2,0)  ==  3

1 2	posicion (0,0) == 0 posicion (2,0) == 3

Finalmente, comprobar con QuickCheck que para cualquier par (x,y) de números naturales, la (posicion (x,y)) es igual a (y + (x+y+1)*(x+y) div 2).

Nota. En la comprobación usar

   quickCheckWith (stdArgs {maxSize=7}) prop_posicion

1	quickCheckWith (stdArgs {maxSize=7}) prop_posicion

Soluciones

import Test.QuickCheck

pares :: [(Int,Int)]
pares = [(n-y,y) | n <- [0..], y <- [0..n]] 

posicion :: (Int,Int) -> Int
posicion p = length (takeWhile (/=p) pares)

-- La propiedad es
prop_posicion :: (Int,Int) -> Property
prop_posicion (x,y) =
    x >= 0 && y >= 0 ==> 
    posicion (x,y) == y + (x+y+1)*(x+y) `div` 2

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

import Test.QuickCheck

pares :: [(Int,Int)]

pares = [(n-y,y) | n <- [0..], y <- [0..n]]

posicion :: (Int,Int) -> Int

posicion p = length (takeWhile (/=p) pares)

-- La propiedad es

prop_posicion :: (Int,Int) -> Property

prop_posicion (x,y) =

x >= 0 && y >= 0 ==>

posicion (x,y) == y + (x+y+1)*(x+y) `div` 2

-- La comprobación es

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

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

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

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 [] _ = []

Expresiones vectoriales

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

Enunciado

-- El siguiente tipo de dato define representa las expresiones
-- vectoriales formadas por un vector, la suma de dos expresiones
-- vectoriales o el producto de un entero por una expresión vectorial. 
--    data ExpV = Vec Int Int
--              | Sum ExpV ExpV
--              | Mul Int ExpV
--              deriving Show
-- 
-- Definir la función 
--    valor :: ExpV -> (Int,Int)
-- tal que (valor e) es el valor de la expresión vectorial c. Por
-- ejemplo, 
--    valor (Vec 1 2)                                  ==  (1,2)
--    valor (Sum (Vec 1 2 ) (Vec 3 4))                 ==  (4,6)
--    valor (Mul 2 (Vec 3 4))                          ==  (6,8)
--    valor (Mul 2 (Sum (Vec 1 2 ) (Vec 3 4)))         ==  (8,12)
--    valor (Sum (Mul 2 (Vec 1 2)) (Mul 2 (Vec 3 4)))  ==  (8,12)

-- El siguiente tipo de dato define representa las expresiones

-- vectoriales formadas por un vector, la suma de dos expresiones

-- vectoriales o el producto de un entero por una expresión vectorial.

-- data ExpV = Vec Int Int

-- | Sum ExpV ExpV

-- | Mul Int ExpV

-- deriving Show

-- Definir la función

-- valor :: ExpV -> (Int,Int)

-- tal que (valor e) es el valor de la expresión vectorial c. Por

-- ejemplo,

-- valor (Vec 1 2) == (1,2)

-- valor (Sum (Vec 1 2 ) (Vec 3 4)) == (4,6)

-- valor (Mul 2 (Vec 3 4)) == (6,8)

-- valor (Mul 2 (Sum (Vec 1 2 ) (Vec 3 4))) == (8,12)

-- valor (Sum (Mul 2 (Vec 1 2)) (Mul 2 (Vec 3 4))) == (8,12)

data ExpV = Vec Int Int
          | Sum ExpV ExpV
          | Mul Int ExpV
          deriving Show

-- 1ª solución
-- ===========
valor :: ExpV -> (Int,Int)
valor (Vec x y)   = (x,y)
valor (Sum e1 e2) = (x1+x2,y1+y2) where (x1,y1) = valor e1  
                                        (x2,y2) = valor e2  
valor (Mul n e)   = (n*x,n*y) where (x,y) = valor e  

-- 2ª solución
-- ===========
valor2 :: ExpV -> (Int,Int)
valor2 (Vec a b)   = (a, b)
valor2 (Sum e1 e2) = suma (valor2 e1) (valor2 e2)
valor2 (Mul n e1)  = multiplica n (valor2 e1)

suma :: (Int,Int) -> (Int,Int) -> (Int,Int)
suma (a,b) (c,d) = (a+c,b+d)

multiplica :: Int -> (Int, Int) -> (Int, Int)
multiplica n (a,b) = (n*a,n*b)

data ExpV = Vec Int Int

| Sum ExpV ExpV

| Mul Int ExpV

deriving Show

-- 1ª solución

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

valor :: ExpV -> (Int,Int)

valor (Vec x y) = (x,y)

valor (Sum e1 e2) = (x1+x2,y1+y2) where (x1,y1) = valor e1

(x2,y2) = valor e2

valor (Mul n e) = (n*x,n*y) where (x,y) = valor e

-- 2ª solución

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

valor2 :: ExpV -> (Int,Int)

valor2 (Vec a b) = (a, b)

valor2 (Sum e1 e2) = suma (valor2 e1) (valor2 e2)

valor2 (Mul n e1) = multiplica n (valor2 e1)

suma :: (Int,Int) -> (Int,Int) -> (Int,Int)

suma (a,b) (c,d) = (a+c,b+d)

multiplica :: Int -> (Int, Int) -> (Int, Int)

multiplica n (a,b) = (n*a,n*b)

Expresiones aritmética normalizadas

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

Enunciado

-- El siguiente tipo de dato representa expresiones construidas con
-- variables, sumas y productos
--    data Expr = V String
--              | S Expr Expr
--              | P Expr Expr
-- Por ejemplo, x*(y+z) se representa por (P (V "x") (S (V "y") (V "z"))) 
-- 
-- Una expresión es un término si es un producto de variables. Por
-- ejemplo, x*(y*z) es un término pero x+(y*z) ni x*(y+z) lo son.
--
-- Una expresión está en forma normal si es una suma de términos. Por
-- ejemplo, x*(y*z) y x+(y*z) está en forma normal; pero x*(y+z) y
-- (x+y)*(x+z) no lo están. 
-- 
-- Definir las funciones 
--    esTermino, esNormal :: Expr -> Bool
-- tales que
-- + (esTermino a) se verifica si a es un término. Por ejemplo,
--      esTermino (V "x")                                    == True
--      esTermino (P (V "x") (P (V "y") (V "z")))            == True
--      esTermino (P (V "x") (S (V "y") (V "z")))            == False
--      esTermino (S (V "x") (P (V "y") (V "z")))            == False
-- + (esNormal a) se verifica si a está en forma normal. Por ejemplo,
--      esNormal (V "x")                                     == True
--      esNormal (P (V "x") (P (V "y") (V "z")))             == True
--      esNormal (S (V "x") (P (V "y") (V "z")))             == True
--      esNormal (P (V "x") (S (V "y") (V "z")))             == False
--      esNormal (P (S (V "x") (V "y")) (S (V "y") (V "z"))) == False

-- El siguiente tipo de dato representa expresiones construidas con

-- variables, sumas y productos

-- data Expr = V String

-- | S Expr Expr

-- | P Expr Expr

-- Por ejemplo, x*(y+z) se representa por (P (V "x") (S (V "y") (V "z")))

-- Una expresión es un término si es un producto de variables. Por

-- ejemplo, x*(y*z) es un término pero x+(y*z) ni x*(y+z) lo son.

-- Una expresión está en forma normal si es una suma de términos. Por

-- ejemplo, x*(y*z) y x+(y*z) está en forma normal; pero x*(y+z) y

-- (x+y)*(x+z) no lo están.

-- Definir las funciones

-- esTermino, esNormal :: Expr -> Bool

-- tales que

-- + (esTermino a) se verifica si a es un término. Por ejemplo,

-- esTermino (V "x") == True

-- esTermino (P (V "x") (P (V "y") (V "z"))) == True

-- esTermino (P (V "x") (S (V "y") (V "z"))) == False

-- esTermino (S (V "x") (P (V "y") (V "z"))) == False

-- + (esNormal a) se verifica si a está en forma normal. Por ejemplo,

-- esNormal (V "x") == True

-- esNormal (P (V "x") (P (V "y") (V "z"))) == True

-- esNormal (S (V "x") (P (V "y") (V "z"))) == True

-- esNormal (P (V "x") (S (V "y") (V "z"))) == False

-- esNormal (P (S (V "x") (V "y")) (S (V "y") (V "z"))) == False

Soluciones

data Expr = V String
          | S Expr Expr
          | P Expr Expr

esTermino :: Expr -> Bool
esTermino (V _)   = True
esTermino (S _ _) = False
esTermino (P a b) = esTermino a && esTermino b

esNormal :: Expr -> Bool
esNormal (S a b) = esNormal a && esNormal b
esNormal a       = esTermino a

data Expr = V String

| S Expr Expr

| P Expr Expr

esTermino :: Expr -> Bool

esTermino (V _) = True

esTermino (S _ _) = False

esTermino (P a b) = esTermino a && esTermino b

esNormal :: Expr -> Bool

esNormal (S a b) = esNormal a && esNormal b

esNormal a = esTermino a

Acrónimos

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

Introducción

A partir de una palabra de puede formar un acrónimo uniendo un prefijo de la primera con un sufijo de la segunda. Por ejemplo,

«ofimática» es un acrónimo de «oficina» e «informática»
«informática» es un acrónimo de «información» y «automática»
«teleñeco» es un acrónimo de «televisión» y «muñeco»

Enunciado

-- Definir la función
--    esAcronimo :: String -> String -> String -> Bool
-- tal que (esAcronimo xs ys zs) se verifica si xs es un acrónimo de ys
-- y zs. Por ejemplo,
--    esAcronimo "ofimatica" "oficina" "informatica"       ==  True
--    esAcronimo "informatica" "informacion" "automatica"  ==  True

-- Definir la función

-- esAcronimo :: String -> String -> String -> Bool

-- tal que (esAcronimo xs ys zs) se verifica si xs es un acrónimo de ys

-- y zs. Por ejemplo,

-- esAcronimo "ofimatica" "oficina" "informatica" == True

-- esAcronimo "informatica" "informacion" "automatica" == True

import Data.List
import Test.QuickCheck

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

esAcronimo1 :: String -> String -> String -> Bool
esAcronimo1 xs ys zs =
    xs `elem` acronimos ys zs

-- (acronimos xs ys) es la lista de acrónimos de xs e ys. Por ejemplo,
--    ghci> acronimos "ab" "cde"
--    ["cde","de","e","","acde","ade","ae","a","abcde","abde","abe","ab"]
acronimos :: String -> String -> [String]
acronimos xs ys =
    [us++vs | us <- inits xs, vs <- tails ys]

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

esAcronimo2 :: String -> String -> String -> Bool
esAcronimo2 xs ys zs = 
    or [isPrefixOf us ys && isSuffixOf vs zs | 
        (us,vs) <- [splitAt n xs | n <- [0..length xs]]]

-- Verificación de equivalencia
-- ============================

-- La propiedad es
prop_esAcronimo :: String -> String -> String -> Bool
prop_esAcronimo xs ys zs =
    esAcronimo1 xs ys zs == esAcronimo2 xs ys zs

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

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

-- La comparación es
--    ghci> let r = replicate
--    
--    ghci> let n = 500 in esAcronimo1 (r n 'a' ++ r n 'b') (r n 'a') (r n 'b')
--    True
--    (3.76 secs, 1779334696 bytes)
--    
--    ghci> let n = 500 in esAcronimo2 (r n 'a' ++ r n 'b') (r n 'a') (r n 'b')
--    True
--    (0.04 secs, 16715376 bytes)
--
-- La 2ª definición es más eficiente

import Data.List

import Test.QuickCheck

-- 1ª definición

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

esAcronimo1 :: String -> String -> String -> Bool

esAcronimo1 xs ys zs =

xs `elem` acronimos ys zs

-- (acronimos xs ys) es la lista de acrónimos de xs e ys. Por ejemplo,

-- ghci> acronimos "ab" "cde"

-- ["cde","de","e","","acde","ade","ae","a","abcde","abde","abe","ab"]

acronimos :: String -> String -> [String]

acronimos xs ys =

[us++vs | us <- inits xs, vs <- tails ys]

-- 2ª definición

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

esAcronimo2 :: String -> String -> String -> Bool

esAcronimo2 xs ys zs =

or [isPrefixOf us ys && isSuffixOf vs zs |

(us,vs) <- [splitAt n xs | n <- [0..length xs]]]

-- Verificación de equivalencia

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

-- La propiedad es

prop_esAcronimo :: String -> String -> String -> Bool

prop_esAcronimo xs ys zs =

esAcronimo1 xs ys zs == esAcronimo2 xs ys zs

-- La comprobación es

-- ghci> quickCheck prop_esAcronimo

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- ghci> let r = replicate

-- ghci> let n = 500 in esAcronimo1 (r n 'a' ++ r n 'b') (r n 'a') (r n 'b')

-- True

-- (3.76 secs, 1779334696 bytes)

-- ghci> let n = 500 in esAcronimo2 (r n 'a' ++ r n 'b') (r n 'a') (r n 'b')

-- True

-- (0.04 secs, 16715376 bytes)

-- La 2ª definición es más eficiente

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]

Inversa a trozos

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

Enunciado

-- Definir la función 
--    inversa :: Int -> [a] -> [a]
-- tal que (inversa k xs) es la lista obtenida invirtiendo elementos de
-- xs, k elementos cada vez. Si el número de elementos de xs no es un
-- múltiplo de k, entonces los finales elementos de xs se dejen sin
-- invertir. Por ejemplo,
--    inversa 3 [1..11]  ==  [3,2,1,6,5,4,9,8,7,10,11]
--    inversa 4 [1..11]  ==  [4,3,2,1,8,7,6,5,9,10,11]
--
-- Comprobar con QuickCheck que la función inversa es involutiva; es
-- decir, para todo número k>0 y toda lista xs, se tiene que
-- (inversa k (inversa k xs)) es igual a xs

-- Definir la función

-- inversa :: Int -> [a] -> [a]

-- tal que (inversa k xs) es la lista obtenida invirtiendo elementos de

-- xs, k elementos cada vez. Si el número de elementos de xs no es un

-- múltiplo de k, entonces los finales elementos de xs se dejen sin

-- invertir. Por ejemplo,

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

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

-- Comprobar con QuickCheck que la función inversa es involutiva; es

-- decir, para todo número k>0 y toda lista xs, se tiene que

-- (inversa k (inversa k xs)) es igual a xs

Soluciones

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

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

import Test.QuickCheck

-- 1ª definición
inversa1 :: Int -> [a] -> [a]
inversa1 k xs 
    | length xs < k = xs
    | otherwise     = reverse (take k xs) ++ inversa1 k (drop k xs) 

-- 2ª definición 
inversa2 :: Int -> [a] -> [a]
inversa2 k xs = aux xs (length xs) where
    aux xs n
        | n < k     = xs
        | otherwise = reverse (take k xs) ++ aux (drop k xs) (n-k)


-- La dos definiciones son equivalentes
prop_equivalencia ::Int -> [Int] -> Property
prop_equivalencia k xs =
    k > 0 ==> inversa1 k xs == inversa2 k xs

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

-- La segunda es más eficiente
--    ghci> :set +s 
--    
--    ghci> last (inversa1 3 [1..100000])
--    100000
--    (16.42 secs, 17576420 bytes)
--     
--    ghci> last (inversa2 3 [1..100000])
--    100000
--    (0.11 secs, 18171356 bytes)

-- La propiedad es 
prop_inversa :: Int -> [Int] -> Property
prop_inversa k xs =
    k > 0 ==> inversa2 k (inversa2 k xs) == xs

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

import Test.QuickCheck

-- 1ª definición

inversa1 :: Int -> [a] -> [a]

inversa1 k xs

| length xs < k = xs

| otherwise = reverse (take k xs) ++ inversa1 k (drop k xs)

-- 2ª definición

inversa2 :: Int -> [a] -> [a]

inversa2 k xs = aux xs (length xs) where

aux xs n

| n < k = xs

| otherwise = reverse (take k xs) ++ aux (drop k xs) (n-k)

-- La dos definiciones son equivalentes

prop_equivalencia ::Int -> [Int] -> Property

prop_equivalencia k xs =

k > 0 ==> inversa1 k xs == inversa2 k xs

-- La comprobación es

-- ghci> quickCheck prop_equivalencia

-- +++ OK, passed 100 tests.

-- La segunda es más eficiente

-- ghci> :set +s

-- ghci> last (inversa1 3 [1..100000])

-- 100000

-- (16.42 secs, 17576420 bytes)

-- ghci> last (inversa2 3 [1..100000])

-- 100000

-- (0.11 secs, 18171356 bytes)

-- La propiedad es

prop_inversa :: Int -> [Int] -> Property

prop_inversa k xs =

k > 0 ==> inversa2 k (inversa2 k xs) == xs

-- La comprobación es

-- ghci> quickCheck prop_inversa

-- +++ OK, passed 100 tests.

[/schedule]

Mínimos locales

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

Enunciado

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

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

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

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

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

-- Definir la función

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

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

-- lista xs. Por ejemplo,

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

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

-- minimosLocales "mqexvzat" == "eva"

Soluciones

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

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

[/schedule]

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

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

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

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

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

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

| otherwise = minimosLocales1 (y:z:xs)

minimosLocales1 _ = []

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

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

minimosLocales2 xs =

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

[/schedule]

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.

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Introducción

Enunciado

Soluciones

Enunciado

Soluciones

Exercitium

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Soluciones

Referencias

Soluciones

Enunciado

Soluciones

Soluciones

Soluciones

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Enunciado

Soluciones

Introducción

Enunciado

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Enunciado

Soluciones

Entradas recientes

Buscar

Correo electrónico