La semana en Exercitium (del 28 de febrero al 4 de marzo)

Esta semana he publicado en Exercitium las soluciones de los siguientes problemas:

1. Determinación de los elementos minimales
2. Mastermind
3. Primos consecutivos con media capicúa
4. Iguales al siguiente
5. Ordenación por el máximo

A continuación se muestran las soluciones.

1. Determinación de los elementos minimales

-- ---------------------------------------------------------------------
-- Definir la función
--    minimales :: Ord a => [[a]] -> [[a]]
-- tal que (minimales xss) es la lista de los elementos de xss que no
-- están contenidos en otros elementos de xss. Por ejemplo,
--    minimales [[1,3],[2,3,1],[3,2,5]]        ==  [[2,3,1],[3,2,5]]
--    minimales [[1,3],[2,3,1],[3,2,5],[3,1]]  ==  [[2,3,1],[3,2,5]]
--    map sum (minimales [[1..n] | n <- [1..300]])  ==  [45150]
-- ---------------------------------------------------------------------

module Elementos_minimales where

import Data.List (delete, nub)
import Test.QuickCheck (quickCheck)

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

minimales :: Ord a => [[a]] -> [[a]]
minimales xss =
  [xs | xs <- xss,
        null [ys | ys <- xss, subconjuntoPropio xs ys]]

-- (subconjuntoPropio xs ys) se verifica si xs es un subconjunto propio
-- de ys. Por ejemplo,
--    subconjuntoPropio [1,3] [3,1,3]    ==  False
--    subconjuntoPropio [1,3,1] [3,1,2]  ==  True
subconjuntoPropio :: Ord a => [a] -> [a] -> Bool
subconjuntoPropio xs ys = aux (nub xs) (nub ys)
  where
    aux _       []  = False
    aux []      _   = True
    aux (u:us) vs = u `elem` vs && aux us (delete u vs)

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

minimales2 :: Ord a => [[a]] -> [[a]]
minimales2 xss =
  [xs | xs <- xss,
        null [ys | ys <- xss, subconjuntoPropio2 xs ys]]

subconjuntoPropio2 :: Ord a => [a] -> [a] -> Bool
subconjuntoPropio2 xs ys =
  subconjunto xs ys && not (subconjunto ys xs)

-- (subconjunto xs ys) se verifica si xs es un subconjunto de ys. Por
-- ejemplo,
--    subconjunto [1,3] [3,1,3]        ==  True
--    subconjunto [1,3,1,3] [3,1,3]    ==  True
--    subconjunto [1,3,2,3] [3,1,3]    ==  False
--    subconjunto [1,3,1,3] [3,1,3,2]  ==  True
subconjunto :: Ord a => [a] -> [a] -> Bool
subconjunto xs ys =
  all (`elem` ys) xs

-- Equivalencia de las definiciones
-- ================================

-- La propiedad es
prop_minimales :: [[Int]] -> Bool
prop_minimales xss =
   minimales xss == minimales2 xss

verifica_minimales :: IO ()
verifica_minimales =
  quickCheck prop_minimales

-- La comprobación es
--    λ> verifica_minimales
--    +++ OK, passed 100 tests.

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

-- La comparación es
--    λ> length (minimales [[1..n] | n <- [1..200]])
--    1
--    (2.30 secs, 657,839,560 bytes)
--    λ> length (minimales2 [[1..n] | n <- [1..200]])
--    1
--    (0.84 secs, 101,962,480 bytes)

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

-- Definir la función

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

-- tal que (minimales xss) es la lista de los elementos de xss que no

-- están contenidos en otros elementos de xss. Por ejemplo,

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

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

-- map sum (minimales [[1..n] | n <- [1..300]]) == [45150]

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

module Elementos_minimales where

import Data.List (delete, nub)

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

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

minimales xss =

[xs | xs <- xss,

null [ys | ys <- xss, subconjuntoPropio xs ys]]

-- (subconjuntoPropio xs ys) se verifica si xs es un subconjunto propio

-- de ys. Por ejemplo,

-- subconjuntoPropio [1,3] [3,1,3] == False

-- subconjuntoPropio [1,3,1] [3,1,2] == True

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

subconjuntoPropio xs ys = aux (nub xs) (nub ys)

where

aux _ [] = False

aux [] _ = True

aux (u:us) vs = u `elem` vs && aux us (delete u vs)

-- 2ª solución

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

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

minimales2 xss =

[xs | xs <- xss,

null [ys | ys <- xss, subconjuntoPropio2 xs ys]]

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

subconjuntoPropio2 xs ys =

subconjunto xs ys && not (subconjunto ys xs)

-- (subconjunto xs ys) se verifica si xs es un subconjunto de ys. Por

-- ejemplo,

-- subconjunto [1,3] [3,1,3] == True

-- subconjunto [1,3,1,3] [3,1,3] == True

-- subconjunto [1,3,2,3] [3,1,3] == False

-- subconjunto [1,3,1,3] [3,1,3,2] == True

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

subconjunto xs ys =

all (`elem` ys) xs

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_minimales :: [[Int]] -> Bool

prop_minimales xss =

minimales xss == minimales2 xss

verifica_minimales :: IO ()

verifica_minimales =

quickCheck prop_minimales

-- La comprobación es

-- λ> verifica_minimales

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (minimales [[1..n] | n <- [1..200]])

-- 1

-- (2.30 secs, 657,839,560 bytes)

-- λ> length (minimales2 [[1..n] | n <- [1..200]])

-- 1

-- (0.84 secs, 101,962,480 bytes)

2. Mastermind

-- ---------------------------------------------------------------------
-- El Mastermind es un juego que consiste en deducir un código
-- numérico formado por una lista de números. Cada vez que se empieza
-- una partida, el programa debe elegir un código, que será lo que el
-- jugador debe adivinar en la menor cantidad de intentos posibles. Cada
-- intento consiste en una propuesta de un código posible que propone el
-- jugador, y una respuesta del programa. Las respuestas le darán pistas
-- al jugador para que pueda deducir el código.
--
-- Estas pistas indican lo cerca que estuvo el número propuesto de la
-- solución a través de dos valores: la cantidad de aciertos es la
-- cantidad de dígitos que propuso el jugador que también están en el
-- código en la misma posición. La cantidad de coincidencias es la
-- cantidad de dígitos que propuso el jugador que también están en el
-- código pero en una posición distinta.
--
-- Por ejemplo, si el código que eligió el programa es el [2,6,0,7] y
-- el jugador propone el [1,4,0,6], el programa le debe responder un
-- acierto (el 0, que está en el código original en el mismo lugar, el
-- tercero), y una coincidencia (el 6, que también está en el código
-- original, pero en la segunda posición, no en el cuarto como fue
-- propuesto). Si el jugador hubiera propuesto el [3,5,9,1], habría
-- obtenido como respuesta ningún acierto y ninguna coincidencia, ya que
-- no hay números en común con el código original. Si se obtienen
-- cuatro aciertos es porque el jugador adivinó el código y ganó el
-- juego.
--
-- Definir la función
--    mastermind :: [Int] -> [Int] -> (Int,Int)
-- tal que (mastermind xs ys) es el par formado por los números de
-- aciertos y de coincidencias entre xs e ys. Por ejemplo,
--    mastermind [3,3] [3,2]          ==  (1,0)
--    mastermind [3,5,3] [3,2,5]      ==  (1,1)
--    mastermind [3,5,3,2] [3,2,5,3]  ==  (1,3)
--    mastermind [3,5,3,3] [3,2,5,3]  ==  (2,1)
--    mastermind [1..10^6] [1..10^6]  ==  (1000000,0)
-- ---------------------------------------------------------------------

module Mastermind where

import qualified Data.Set as S
import Test.QuickCheck (quickCheck)

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

mastermind :: [Int] -> [Int] -> (Int, Int)
mastermind xs ys =
  (length (aciertos xs ys), length (coincidencias xs ys))

-- (aciertos xs ys) es la lista de las posiciones de los aciertos entre
-- xs e ys. Por ejemplo,
--    aciertos [1,1,0,7] [1,0,1,7]  ==  [0,3]
aciertos :: Eq a => [a] -> [a] -> [Int]
aciertos xs ys =
  [n | (n,x,y) <- zip3 [0..] xs ys, x == y]

-- (coincidencia xs ys) es la lista de las posiciones de las
-- coincidencias entre xs e ys. Por ejemplo,
--    coincidencias [1,1,0,7] [1,0,1,7]  ==  [1,2]
coincidencias :: Eq a => [a] -> [a] -> [Int]
coincidencias xs ys =
  [n | (n,y) <- zip [0..] ys,
       y `elem` xs,
       n `notElem` aciertos xs ys]

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

mastermind2 :: [Int] -> [Int] -> (Int, Int)
mastermind2 xs ys =
  (length aciertos2, length coincidencias2)
  where
    aciertos2, coincidencias2 :: [Int]
    aciertos2      = [n | (n,x,y) <- zip3 [0..] xs ys, x == y]
    coincidencias2 = [n | (n,y) <- zip [0..] ys, y `elem` xs, n `notElem` aciertos2]

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

mastermind3 :: [Int] -> [Int] -> (Int, Int)
mastermind3 xs ys = aux xs ys
  where aux (u:us) (v:vs)
          | u == v      = (a+1,b)
          | v `elem` xs = (a,b+1)
          | otherwise   = (a,b)
          where (a,b) = aux us vs
        aux _ _ = (0,0)

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

mastermind4 :: [Int] -> [Int] -> (Int, Int)
mastermind4 xs ys =
  (length aciertos4, length coincidencias4)
  where
    aciertos4, coincidencias4 :: [Int]
    aciertos4      = [n | (n,x,y) <- zip3 [0..] xs ys, x == y]
    xs'            = S.fromList xs
    coincidencias4 = [n | (n,y) <- zip [0..] ys, y `S.member` xs', n `notElem` aciertos4]

-- Equivalencia de las definiciones
-- ================================

-- La propiedad es
prop_mastermind :: [Int] -> [Int] -> Bool
prop_mastermind xs ys =
  all (== mastermind xs1 ys1)
      [mastermind2 xs1 ys1,
       mastermind3 xs1 ys1,
       mastermind4 xs1 ys1]
  where n   = min (length xs) (length ys)
        xs1 = take n xs
        ys1 = take n ys

verifica_mastermind :: IO ()
verifica_mastermind = quickCheck prop_mastermind

-- La comprobación es
--    λ> verifica_mastermind
--    +++ OK, passed 100 tests.

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

-- La comparación es
--    λ> mastermind [1..10^4] (map (*2) [1..10^4])
--    (0,5000)
--    (14.17 secs, 11,209,750,408 bytes)
--    λ> mastermind2 [1..10^4] (map (*2) [1..10^4])
--    (0,5000)
--    (0.83 secs, 8,190,200 bytes)
--    λ> mastermind3 [1..10^4] (map (*2) [1..10^4])
--    (0,5000)
--    (0.61 secs, 7,339,232 bytes)
--    λ> mastermind4 [1..10^4] (map (*2) [1..10^4])
--    (0,5000)
--    (0.03 secs, 8,910,128 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

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

-- El Mastermind es un juego que consiste en deducir un código

-- numérico formado por una lista de números. Cada vez que se empieza

-- una partida, el programa debe elegir un código, que será lo que el

-- jugador debe adivinar en la menor cantidad de intentos posibles. Cada

-- intento consiste en una propuesta de un código posible que propone el

-- jugador, y una respuesta del programa. Las respuestas le darán pistas

-- al jugador para que pueda deducir el código.

-- Estas pistas indican lo cerca que estuvo el número propuesto de la

-- solución a través de dos valores: la cantidad de aciertos es la

-- cantidad de dígitos que propuso el jugador que también están en el

-- código en la misma posición. La cantidad de coincidencias es la

-- cantidad de dígitos que propuso el jugador que también están en el

-- código pero en una posición distinta.

-- Por ejemplo, si el código que eligió el programa es el [2,6,0,7] y

-- el jugador propone el [1,4,0,6], el programa le debe responder un

-- acierto (el 0, que está en el código original en el mismo lugar, el

-- tercero), y una coincidencia (el 6, que también está en el código

-- original, pero en la segunda posición, no en el cuarto como fue

-- propuesto). Si el jugador hubiera propuesto el [3,5,9,1], habría

-- obtenido como respuesta ningún acierto y ninguna coincidencia, ya que

-- no hay números en común con el código original. Si se obtienen

-- cuatro aciertos es porque el jugador adivinó el código y ganó el

-- juego.

-- Definir la función

-- mastermind :: [Int] -> [Int] -> (Int,Int)

-- tal que (mastermind xs ys) es el par formado por los números de

-- aciertos y de coincidencias entre xs e ys. Por ejemplo,

-- mastermind [3,3] [3,2] == (1,0)

-- mastermind [3,5,3] [3,2,5] == (1,1)

-- mastermind [3,5,3,2] [3,2,5,3] == (1,3)

-- mastermind [3,5,3,3] [3,2,5,3] == (2,1)

-- mastermind [1..10^6] [1..10^6] == (1000000,0)

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

module Mastermind where

import qualified Data.Set as S

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

mastermind :: [Int] -> [Int] -> (Int, Int)

mastermind xs ys =

(length (aciertos xs ys), length (coincidencias xs ys))

-- (aciertos xs ys) es la lista de las posiciones de los aciertos entre

-- xs e ys. Por ejemplo,

-- aciertos [1,1,0,7] [1,0,1,7] == [0,3]

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

aciertos xs ys =

[n | (n,x,y) <- zip3 [0..] xs ys, x == y]

-- (coincidencia xs ys) es la lista de las posiciones de las

-- coincidencias entre xs e ys. Por ejemplo,

-- coincidencias [1,1,0,7] [1,0,1,7] == [1,2]

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

coincidencias xs ys =

[n | (n,y) <- zip [0..] ys,

y `elem` xs,

n `notElem` aciertos xs ys]

-- 2ª solución

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

mastermind2 :: [Int] -> [Int] -> (Int, Int)

mastermind2 xs ys =

(length aciertos2, length coincidencias2)

where

aciertos2, coincidencias2 :: [Int]

aciertos2 = [n | (n,x,y) <- zip3 [0..] xs ys, x == y]

coincidencias2 = [n | (n,y) <- zip [0..] ys, y `elem` xs, n `notElem` aciertos2]

-- 3ª solución

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

mastermind3 :: [Int] -> [Int] -> (Int, Int)

mastermind3 xs ys = aux xs ys

where aux (u:us) (v:vs)

| u == v = (a+1,b)

| v `elem` xs = (a,b+1)

| otherwise = (a,b)

where (a,b) = aux us vs

aux _ _ = (0,0)

-- 4ª solución

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

mastermind4 :: [Int] -> [Int] -> (Int, Int)

mastermind4 xs ys =

(length aciertos4, length coincidencias4)

where

aciertos4, coincidencias4 :: [Int]

aciertos4 = [n | (n,x,y) <- zip3 [0..] xs ys, x == y]

xs' = S.fromList xs

coincidencias4 = [n | (n,y) <- zip [0..] ys, y `S.member` xs', n `notElem` aciertos4]

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_mastermind :: [Int] -> [Int] -> Bool

prop_mastermind xs ys =

all (== mastermind xs1 ys1)

[mastermind2 xs1 ys1,

mastermind3 xs1 ys1,

mastermind4 xs1 ys1]

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

xs1 = take n xs

ys1 = take n ys

verifica_mastermind :: IO ()

verifica_mastermind = quickCheck prop_mastermind

-- La comprobación es

-- λ> verifica_mastermind

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> mastermind [1..10^4] (map (*2) [1..10^4])

-- (0,5000)

-- (14.17 secs, 11,209,750,408 bytes)

-- λ> mastermind2 [1..10^4] (map (*2) [1..10^4])

-- (0,5000)

-- (0.83 secs, 8,190,200 bytes)

-- λ> mastermind3 [1..10^4] (map (*2) [1..10^4])

-- (0,5000)

-- (0.61 secs, 7,339,232 bytes)

-- λ> mastermind4 [1..10^4] (map (*2) [1..10^4])

-- (0,5000)

-- (0.03 secs, 8,910,128 bytes)

3. Primos consecutivos con media capicúa

-- ---------------------------------------------------------------------
-- Definir la lista
--    primosConsecutivosConMediaCapicua :: [(Int,Int,Int)]
-- formada por las ternas (x,y,z) tales que x e y son primos
-- consecutivos cuya media, z, es capicúa. Por ejemplo,
--    λ> take 5 primosConsecutivosConMediaCapicua
--    [(3,5,4),(5,7,6),(7,11,9),(97,101,99),(109,113,111)]
--    λ> primosConsecutivosConMediaCapicua !! 500
--    (5687863,5687867,5687865)
-- ---------------------------------------------------------------------

module Primos_consecutivos_con_media_capicua where

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

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

primosConsecutivosConMediaCapicua :: [(Integer,Integer,Integer)]
primosConsecutivosConMediaCapicua =
  [(x,y,z) | (x,y) <- zip primosImpares (tail primosImpares),
             let z = (x + y) `div` 2,
             capicua z]

-- (primo x) se verifica si x es primo. Por ejemplo,
--    primo 7  ==  True
--    primo 8  ==  False
primo :: Integer -> Bool
primo x = [y | y <- [1..x], x `rem` y == 0] == [1,x]

-- primosImpares es la lista de los números primos impares. Por ejemplo,
--    take 10 primosImpares  ==  [3,5,7,11,13,17,19,23,29]
primosImpares :: [Integer]
primosImpares = [x | x <- [3,5..], primo x]

-- (capicua x) se verifica si x es capicúa. Por ejemplo,
capicua :: Integer -> Bool
capicua x = ys == reverse ys
  where ys = show x

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

primosConsecutivosConMediaCapicua2 :: [(Integer,Integer,Integer)]
primosConsecutivosConMediaCapicua2 =
  [(x,y,z) | (x,y) <- zip primosImpares2 (tail primosImpares2),
             let z = (x + y) `div` 2,
             capicua z]

primosImpares2 :: [Integer]
primosImpares2 = tail (criba [2..])
  where criba (p:ps) = p : criba [n | n <- ps, mod n p /= 0]

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

primosConsecutivosConMediaCapicua3 :: [(Integer,Integer,Integer)]
primosConsecutivosConMediaCapicua3 =
  [(x,y,z) | (x,y) <- zip (tail primos3) (drop 2 primos3),
             let z = (x + y) `div` 2,
             capicua z]

primos3 :: [Integer]
primos3 = 2 : 3 : criba3 0 (tail primos3) 3
  where criba3 k (p:ps) x = [n | n <- [x+2,x+4..p*p-2],
                                 and [n `rem` q /= 0 | q <- take k (tail primos3)]]
                            ++ criba3 (k+1) ps (p*p)

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

primosConsecutivosConMediaCapicua4 :: [(Integer,Integer,Integer)]
primosConsecutivosConMediaCapicua4 =
  [(x,y,z) | (x,y) <- zip (tail primes) (drop 2 primes),
             let z = (x + y) `div` 2,
             capicua z]

-- Equivalencia de definiciones
-- ============================

-- La propiedad es
prop_primosConsecutivosConMediaCapicua :: Integer -> Bool
prop_primosConsecutivosConMediaCapicua n =
  all (== genericTake n primosConsecutivosConMediaCapicua)
      [genericTake n primosConsecutivosConMediaCapicua2,
       genericTake n primosConsecutivosConMediaCapicua3,
       genericTake n primosConsecutivosConMediaCapicua4]

-- La comprobación es
--    λ> prop_primosConsecutivosConMediaCapicua 25
--    True

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

-- La comparación es
--    λ> primosConsecutivosConMediaCapicua !! 30
--    (12919,12923,12921)
--    (4.60 secs, 1,877,064,288 bytes)
--    λ> primosConsecutivosConMediaCapicua2 !! 30
--    (12919,12923,12921)
--    (0.69 secs, 407,055,848 bytes)
--    λ> primosConsecutivosConMediaCapicua3 !! 30
--    (12919,12923,12921)
--    (0.07 secs, 18,597,104 bytes)
--    λ> primosConsecutivosConMediaCapicua4 !! 30
--    (12919,12923,12921)
--    (0.01 secs, 10,065,784 bytes)
--
--    λ> primosConsecutivosConMediaCapicua2 !! 40
--    (29287,29297,29292)
--    (2.67 secs, 1,775,554,576 bytes)
--    λ> primosConsecutivosConMediaCapicua3 !! 40
--    (29287,29297,29292)
--    (0.09 secs, 32,325,808 bytes)
--    λ> primosConsecutivosConMediaCapicua4 !! 40
--    (29287,29297,29292)
--    (0.01 secs, 22,160,072 bytes)
--
--    λ> primosConsecutivosConMediaCapicua3 !! 150
--    (605503,605509,605506)
--    (3.68 secs, 2,298,403,864 bytes)
--    λ> primosConsecutivosConMediaCapicua4 !! 150
--    (605503,605509,605506)
--    (0.24 secs, 491,917,240 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

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

-- Definir la lista

-- primosConsecutivosConMediaCapicua :: [(Int,Int,Int)]

-- formada por las ternas (x,y,z) tales que x e y son primos

-- consecutivos cuya media, z, es capicúa. Por ejemplo,

-- λ> take 5 primosConsecutivosConMediaCapicua

-- [(3,5,4),(5,7,6),(7,11,9),(97,101,99),(109,113,111)]

-- λ> primosConsecutivosConMediaCapicua !! 500

-- (5687863,5687867,5687865)

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

module Primos_consecutivos_con_media_capicua where

import Data.List (genericTake)

import Data.Numbers.Primes (primes)

-- 1ª solución

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

primosConsecutivosConMediaCapicua :: [(Integer,Integer,Integer)]

primosConsecutivosConMediaCapicua =

[(x,y,z) | (x,y) <- zip primosImpares (tail primosImpares),

let z = (x + y) `div` 2,

capicua z]

-- (primo x) se verifica si x es primo. Por ejemplo,

-- primo 7 == True

-- primo 8 == False

primo :: Integer -> Bool

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

-- primosImpares es la lista de los números primos impares. Por ejemplo,

-- take 10 primosImpares == [3,5,7,11,13,17,19,23,29]

primosImpares :: [Integer]

primosImpares = [x | x <- [3,5..], primo x]

-- (capicua x) se verifica si x es capicúa. Por ejemplo,

capicua :: Integer -> Bool

capicua x = ys == reverse ys

where ys = show x

-- 2ª solución

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

primosConsecutivosConMediaCapicua2 :: [(Integer,Integer,Integer)]

primosConsecutivosConMediaCapicua2 =

[(x,y,z) | (x,y) <- zip primosImpares2 (tail primosImpares2),

let z = (x + y) `div` 2,

capicua z]

primosImpares2 :: [Integer]

primosImpares2 = tail (criba [2..])

where criba (p:ps) = p : criba [n | n <- ps, mod n p /= 0]

-- 3ª solución

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

primosConsecutivosConMediaCapicua3 :: [(Integer,Integer,Integer)]

primosConsecutivosConMediaCapicua3 =

[(x,y,z) | (x,y) <- zip (tail primos3) (drop 2 primos3),

let z = (x + y) `div` 2,

capicua z]

primos3 :: [Integer]

primos3 = 2 : 3 : criba3 0 (tail primos3) 3

where criba3 k (p:ps) x = [n | n <- [x+2,x+4..p*p-2],

and [n `rem` q /= 0 | q <- take k (tail primos3)]]

++ criba3 (k+1) ps (p*p)

-- 4ª solución

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

primosConsecutivosConMediaCapicua4 :: [(Integer,Integer,Integer)]

primosConsecutivosConMediaCapicua4 =

[(x,y,z) | (x,y) <- zip (tail primes) (drop 2 primes),

let z = (x + y) `div` 2,

capicua z]

-- Equivalencia de definiciones

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

-- La propiedad es

prop_primosConsecutivosConMediaCapicua :: Integer -> Bool

prop_primosConsecutivosConMediaCapicua n =

all (== genericTake n primosConsecutivosConMediaCapicua)

[genericTake n primosConsecutivosConMediaCapicua2,

genericTake n primosConsecutivosConMediaCapicua3,

genericTake n primosConsecutivosConMediaCapicua4]

-- La comprobación es

-- λ> prop_primosConsecutivosConMediaCapicua 25

-- True

-- Comparación de eficiencia

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

-- La comparación es

-- λ> primosConsecutivosConMediaCapicua !! 30

-- (12919,12923,12921)

-- (4.60 secs, 1,877,064,288 bytes)

-- λ> primosConsecutivosConMediaCapicua2 !! 30

-- (12919,12923,12921)

-- (0.69 secs, 407,055,848 bytes)

-- λ> primosConsecutivosConMediaCapicua3 !! 30

-- (12919,12923,12921)

-- (0.07 secs, 18,597,104 bytes)

-- λ> primosConsecutivosConMediaCapicua4 !! 30

-- (12919,12923,12921)

-- (0.01 secs, 10,065,784 bytes)

-- λ> primosConsecutivosConMediaCapicua2 !! 40

-- (29287,29297,29292)

-- (2.67 secs, 1,775,554,576 bytes)

-- λ> primosConsecutivosConMediaCapicua3 !! 40

-- (29287,29297,29292)

-- (0.09 secs, 32,325,808 bytes)

-- λ> primosConsecutivosConMediaCapicua4 !! 40

-- (29287,29297,29292)

-- (0.01 secs, 22,160,072 bytes)

-- λ> primosConsecutivosConMediaCapicua3 !! 150

-- (605503,605509,605506)

-- (3.68 secs, 2,298,403,864 bytes)

-- λ> primosConsecutivosConMediaCapicua4 !! 150

-- (605503,605509,605506)

-- (0.24 secs, 491,917,240 bytes)

4. Iguales al siguiente

-- ---------------------------------------------------------------------
-- Ejercicio. Definir la función
--    igualesAlSiguiente :: Eq a => [a] -> [a]
-- tal que (igualesAlSiguiente xs) es la lista de los elementos de xs
-- que son iguales a su siguiente. Por ejemplo,
--    igualesAlSiguiente [1,2,2,2,3,3,4]  ==  [2,2,3]
--    igualesAlSiguiente [1..10]          ==  []
-- ---------------------------------------------------------------------

module Iguales_al_siguiente where

import Data.List (group)
import Test.QuickCheck (quickCheck)

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

igualesAlSiguiente1 :: Eq a => [a] -> [a]
igualesAlSiguiente1 xs =
  [x | (x, y) <- consecutivos1 xs, x == y]

-- (consecutivos1 xs) es la lista de pares de elementos consecutivos en
-- xs. Por ejemplo,
--    consecutivos1 [3,5,2,7]  ==  [(3,5),(5,2),(2,7)]
consecutivos1 :: [a] -> [(a, a)]
consecutivos1 xs = zip xs (tail xs)

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

igualesAlSiguiente2 :: Eq a => [a] -> [a]
igualesAlSiguiente2 xs =
  [x | (x,y) <- consecutivos2 xs, x == y]

-- (consecutivos2 xs) es la lista de pares de elementos consecutivos en
-- xs. Por ejemplo,
--    consecutivos2 [3,5,2,7]  ==  [(3,5),(5,2),(2,7)]
consecutivos2 :: [a] -> [(a, a)]
consecutivos2 (x:y:zs) = (x,y) : consecutivos2 (y:zs)
consecutivos2 _        = []

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

igualesAlSiguiente3 :: Eq a => [a] -> [a]
igualesAlSiguiente3 (x:y:zs) | x == y    = x : igualesAlSiguiente3 (y:zs)
                             | otherwise = igualesAlSiguiente3 (y:zs)
igualesAlSiguiente3 _                    = []

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

igualesAlSiguiente4 :: Eq a => [a] -> [a]
igualesAlSiguiente4 xs = concat [ys | (_:ys) <- group xs]

-- 5ª solución
-- ===========

igualesAlSiguiente5 :: Eq a => [a] -> [a]
igualesAlSiguiente5 xs = concat (map tail (group xs))

-- 6ª solución
-- ===========

igualesAlSiguiente6 :: Eq a => [a] -> [a]
igualesAlSiguiente6 xs = tail =<< group xs

-- 7ª solución
-- ===========

igualesAlSiguiente7 :: Eq a => [a] -> [a]
igualesAlSiguiente7 = (tail =<<) . group

-- 8ª solución
-- ===========

igualesAlSiguiente8 :: Eq a => [a] -> [a]
igualesAlSiguiente8 xs = concatMap tail (group xs)

-- 9ª solución
-- ===========

igualesAlSiguiente9 :: Eq a => [a] -> [a]
igualesAlSiguiente9 = concatMap tail . group

-- 10ª solución
-- ===========

igualesAlSiguiente10 :: Eq a => [a] -> [a]
igualesAlSiguiente10 xs = aux xs (tail xs)
  where aux (u:us) (v:vs) | u == v    = u : aux us vs
                          | otherwise = aux us vs
        aux _ _ = []

-- Equivalencia de las definiciones
-- ================================

-- La propiedad es
prop_igualesAlSiguiente :: [Int] -> Bool
prop_igualesAlSiguiente xs =
  all (== igualesAlSiguiente1 xs)
      [igualesAlSiguiente2 xs,
       igualesAlSiguiente3 xs,
       igualesAlSiguiente4 xs,
       igualesAlSiguiente5 xs,
       igualesAlSiguiente6 xs,
       igualesAlSiguiente7 xs,
       igualesAlSiguiente8 xs,
       igualesAlSiguiente9 xs,
       igualesAlSiguiente10 xs]

verificacion :: IO ()
verificacion = quickCheck prop_igualesAlSiguiente

-- La comprobación es
--    λ> verificacion
--    +++ OK, passed 100 tests.

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

-- La comparación es
--    > ej = concatMap show [1..10^6]
--    (0.01 secs, 446,752 bytes)
--    λ> length ej
--    5888896
--    (0.16 secs, 669,787,856 bytes)
--    λ> length (show (igualesAlSiguiente1 ej))
--    588895
--    (1.60 secs, 886,142,944 bytes)
--    λ> length (show (igualesAlSiguiente2 ej))
--    588895
--    (1.95 secs, 1,734,143,816 bytes)
--    λ> length (show (igualesAlSiguiente3 ej))
--    588895
--    (1.81 secs, 1,178,232,104 bytes)
--    λ> length (show (igualesAlSiguiente4 ej))
--    588895
--    (1.43 secs, 1,932,010,304 bytes)
--    λ> length (show (igualesAlSiguiente5 ej))
--    588895
--    (0.40 secs, 2,016,810,320 bytes)
--    λ> length (show (igualesAlSiguiente6 ej))
--    588895
--    (0.32 secs, 1,550,409,984 bytes)
--    λ> length (show (igualesAlSiguiente7 ej))
--    588895
--    (0.34 secs, 1,550,410,104 bytes)
--    λ> length (show (igualesAlSiguiente8 ej))
--    588895
--    (0.33 secs, 1,550,410,024 bytes)
--    λ> length (show (igualesAlSiguiente9 ej))
--    588895
--    (0.33 secs, 1,550,450,968 bytes)
--    λ> length (show (igualesAlSiguiente10 ej))
--    588895
--    (1.54 secs, 754,272,600 bytes)

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

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

-- Ejercicio. Definir la función

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

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

-- que son iguales a su siguiente. Por ejemplo,

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

-- igualesAlSiguiente [1..10] == []

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

module Iguales_al_siguiente where

import Data.List (group)

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

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

igualesAlSiguiente1 xs =

[x | (x, y) <- consecutivos1 xs, x == y]

-- (consecutivos1 xs) es la lista de pares de elementos consecutivos en

-- xs. Por ejemplo,

-- consecutivos1 [3,5,2,7] == [(3,5),(5,2),(2,7)]

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

consecutivos1 xs = zip xs (tail xs)

-- 2ª solución

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

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

igualesAlSiguiente2 xs =

[x | (x,y) <- consecutivos2 xs, x == y]

-- (consecutivos2 xs) es la lista de pares de elementos consecutivos en

-- xs. Por ejemplo,

-- consecutivos2 [3,5,2,7] == [(3,5),(5,2),(2,7)]

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

consecutivos2 (x:y:zs) = (x,y) : consecutivos2 (y:zs)

consecutivos2 _ = []

-- 3ª solución

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

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

igualesAlSiguiente3 (x:y:zs) | x == y = x : igualesAlSiguiente3 (y:zs)

| otherwise = igualesAlSiguiente3 (y:zs)

igualesAlSiguiente3 _ = []

-- 4ª solución

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

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

igualesAlSiguiente4 xs = concat [ys | (_:ys) <- group xs]

-- 5ª solución

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

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

igualesAlSiguiente5 xs = concat (map tail (group xs))

-- 6ª solución

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

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

igualesAlSiguiente6 xs = tail =<< group xs

-- 7ª solución

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

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

igualesAlSiguiente7 = (tail =<<) . group

-- 8ª solución

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

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

igualesAlSiguiente8 xs = concatMap tail (group xs)

-- 9ª solución

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

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

igualesAlSiguiente9 = concatMap tail . group

-- 10ª solución

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

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

igualesAlSiguiente10 xs = aux xs (tail xs)

where aux (u:us) (v:vs) | u == v = u : aux us vs

| otherwise = aux us vs

aux _ _ = []

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_igualesAlSiguiente :: [Int] -> Bool

prop_igualesAlSiguiente xs =

all (== igualesAlSiguiente1 xs)

[igualesAlSiguiente2 xs,

igualesAlSiguiente3 xs,

igualesAlSiguiente4 xs,

igualesAlSiguiente5 xs,

igualesAlSiguiente6 xs,

igualesAlSiguiente7 xs,

igualesAlSiguiente8 xs,

igualesAlSiguiente9 xs,

igualesAlSiguiente10 xs]

verificacion :: IO ()

verificacion = quickCheck prop_igualesAlSiguiente

-- La comprobación es

-- λ> verificacion

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- > ej = concatMap show [1..10^6]

-- (0.01 secs, 446,752 bytes)

-- λ> length ej

-- 5888896

-- (0.16 secs, 669,787,856 bytes)

-- λ> length (show (igualesAlSiguiente1 ej))

-- 588895

-- (1.60 secs, 886,142,944 bytes)

-- λ> length (show (igualesAlSiguiente2 ej))

-- 588895

-- (1.95 secs, 1,734,143,816 bytes)

-- λ> length (show (igualesAlSiguiente3 ej))

-- 588895

-- (1.81 secs, 1,178,232,104 bytes)

-- λ> length (show (igualesAlSiguiente4 ej))

-- 588895

-- (1.43 secs, 1,932,010,304 bytes)

-- λ> length (show (igualesAlSiguiente5 ej))

-- 588895

-- (0.40 secs, 2,016,810,320 bytes)

-- λ> length (show (igualesAlSiguiente6 ej))

-- 588895

-- (0.32 secs, 1,550,409,984 bytes)

-- λ> length (show (igualesAlSiguiente7 ej))

-- 588895

-- (0.34 secs, 1,550,410,104 bytes)

-- λ> length (show (igualesAlSiguiente8 ej))

-- 588895

-- (0.33 secs, 1,550,410,024 bytes)

-- λ> length (show (igualesAlSiguiente9 ej))

-- 588895

-- (0.33 secs, 1,550,450,968 bytes)

-- λ> length (show (igualesAlSiguiente10 ej))

-- 588895

-- (1.54 secs, 754,272,600 bytes)

5. Ordenación por el máximo

-- ---------------------------------------------------------------------
-- Definir la función
--    ordenadosPorMaximo :: Ord a => [[a]] -> [[a]]
-- tal que (ordenadosPorMaximo xss) es la lista de los elementos de xss
-- ordenada por sus máximos (se supone que los elementos de xss son
-- listas no vacía) y cuando tiene el mismo máximo se conserva el orden
-- original. Por ejemplo,
--    λ> ordenadosPorMaximo [[0,8],[9],[8,1],[6,3],[8,2],[6,1],[6,2]]
--    [[6,3],[6,1],[6,2],[0,8],[8,1],[8,2],[9]]
--    λ> ordenadosPorMaximo ["este","es","el","primero"]
--    ["el","primero","es","este"]
-- ---------------------------------------------------------------------

module Ordenados_por_maximo where

import Data.List (sort, sortBy)
import GHC.Exts (sortWith)
import Test.QuickCheck (quickCheck)

-- 1ª solución
ordenadosPorMaximo1 :: Ord a => [[a]] -> [[a]]
ordenadosPorMaximo1 xss =
  map snd (sort [((maximum xs,k),xs) | (k,xs) <- zip [0..] xss])

-- 2ª solución
ordenadosPorMaximo2 :: Ord a => [[a]] -> [[a]]
ordenadosPorMaximo2 xss =
  [xs | (_,xs) <- sort [((maximum xs,k),xs) | (k,xs) <- zip [0..] xss]]

-- 3ª solución
ordenadosPorMaximo3 :: Ord a => [[a]] -> [[a]]
ordenadosPorMaximo3 =
  sortBy (\xs ys -> compare (maximum xs) (maximum ys))

-- 4ª solución
ordenadosPorMaximo4 :: Ord a => [[a]] -> [[a]]
ordenadosPorMaximo4 = sortWith maximum

-- Equivalencia de las definiciones
-- ================================

-- La propiedad es
prop_ordenadosPorMaximo :: [[Int]] -> Bool
prop_ordenadosPorMaximo xss =
  all (== ordenadosPorMaximo1 yss)
      [ordenadosPorMaximo2 yss,
       ordenadosPorMaximo3 yss,
       ordenadosPorMaximo4 yss]
  where yss = filter (not . null) xss

verifica_ordenadosPorMaximo :: IO ()
verifica_ordenadosPorMaximo =
  quickCheck prop_ordenadosPorMaximo

-- La comprobación es
--    λ> verifica_ordenadosPorMaximo
--    +++ OK, passed 100 tests.

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

-- La comparación es
--    λ> length (ordenadosPorMaximo1 [[1..k] | k <- [1..10^4]])
--    10000
--    (6.00 secs, 8,763,714,848 bytes)
--    λ> length (ordenadosPorMaximo2 [[1..k] | k <- [1..10^4]])
--    10000
--    (6.15 secs, 8,764,177,472 bytes)
--    λ> length (ordenadosPorMaximo3 [[1..k] | k <- [1..10^4]])
--    10000
--    (8.16 secs, 13,914,503,672 bytes)
--    λ> length (ordenadosPorMaximo4 [[1..k] | k <- [1..10^4]])
--    10000
--    (7.77 secs, 13,914,183,776 bytes)

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

-- Definir la función

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

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

-- ordenada por sus máximos (se supone que los elementos de xss son

-- listas no vacía) y cuando tiene el mismo máximo se conserva el orden

-- original. Por ejemplo,

-- λ> ordenadosPorMaximo [[0,8],[9],[8,1],[6,3],[8,2],[6,1],[6,2]]

-- [[6,3],[6,1],[6,2],[0,8],[8,1],[8,2],[9]]

-- λ> ordenadosPorMaximo ["este","es","el","primero"]

-- ["el","primero","es","este"]

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

module Ordenados_por_maximo where

import Data.List (sort, sortBy)

import GHC.Exts (sortWith)

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

ordenadosPorMaximo1 xss =

map snd (sort [((maximum xs,k),xs) | (k,xs) <- zip [0..] xss])

-- 2ª solución

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

ordenadosPorMaximo2 xss =

[xs | (_,xs) <- sort [((maximum xs,k),xs) | (k,xs) <- zip [0..] xss]]

-- 3ª solución

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

ordenadosPorMaximo3 =

sortBy (\xs ys -> compare (maximum xs) (maximum ys))

-- 4ª solución

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

ordenadosPorMaximo4 = sortWith maximum

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_ordenadosPorMaximo :: [[Int]] -> Bool

prop_ordenadosPorMaximo xss =

all (== ordenadosPorMaximo1 yss)

[ordenadosPorMaximo2 yss,

ordenadosPorMaximo3 yss,

ordenadosPorMaximo4 yss]

where yss = filter (not . null) xss

verifica_ordenadosPorMaximo :: IO ()

verifica_ordenadosPorMaximo =

quickCheck prop_ordenadosPorMaximo

-- La comprobación es

-- λ> verifica_ordenadosPorMaximo

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (ordenadosPorMaximo1 [[1..k] | k <- [1..10^4]])

-- 10000

-- (6.00 secs, 8,763,714,848 bytes)

-- λ> length (ordenadosPorMaximo2 [[1..k] | k <- [1..10^4]])

-- 10000

-- (6.15 secs, 8,764,177,472 bytes)

-- λ> length (ordenadosPorMaximo3 [[1..k] | k <- [1..10^4]])

-- 10000

-- (8.16 secs, 13,914,503,672 bytes)

-- λ> length (ordenadosPorMaximo4 [[1..k] | k <- [1..10^4]])

-- 10000

-- (7.77 secs, 13,914,183,776 bytes)

1. Determinación de los elementos minimales

2. Mastermind

3. Primos consecutivos con media capicúa

4. Iguales al siguiente

5. Ordenación por el máximo

Se puede imprimir o compartir con