La semana en Exercitium (del 7 al 11 de marzo)

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

1. La bandera tricolor
2. Anagramas
3. Primos equidistantes
4. Suma si todos los valores son justos
5. Posiciones de las diagonales principales

A continuación se muestran las soluciones.

1. La bandera tricolor

-- ---------------------------------------------------------------------
-- El problema de la bandera tricolor consiste en lo siguiente: Dada un
-- lista de objetos xs que pueden ser rojos, amarillos o morados, se pide
-- devolver una lista ys que contiene los elementos de xs, primero los
-- rojos, luego los amarillos y por último los morados.
--
-- Definir el tipo de dato Color para representar los colores con los
-- constructores R, A y M correspondientes al rojo, azul y morado y la
-- función
--    banderaTricolor :: [Color] -> [Color]
-- tal que (banderaTricolor xs) es la bandera tricolor formada con los
-- elementos de xs. Por ejemplo,
--    bandera [M,R,A,A,R,R,A,M,M]  ==  [R,R,R,A,A,A,M,M,M]
--    bandera [M,R,A,R,R,A]        ==  [R,R,R,A,A,M]
-- ---------------------------------------------------------------------

module Bandera_tricolor where

import Data.List (sort)
import Test.QuickCheck (Arbitrary(arbitrary), elements, quickCheck)

data Color = R | A | M
  deriving (Show, Eq, Ord, Enum)

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

banderaTricolor1 :: [Color] -> [Color]
banderaTricolor1 xs =
  [x | x <- xs, x == R] ++
  [x | x <- xs, x == A] ++
  [x | x <- xs, x == M]

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

banderaTricolor2 :: [Color] -> [Color]
banderaTricolor2 xs =
  colores R ++ colores A ++ colores M
  where colores c = filter (== c) xs

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

banderaTricolor3 :: [Color] -> [Color]
banderaTricolor3 xs =
  concat [[x | x <- xs, x == c] | c <- [R,A,M]]

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

banderaTricolor4 :: [Color] -> [Color]
banderaTricolor4 xs = aux xs ([],[],[])
  where aux []     (rs,as,ms) = rs ++ as ++ ms
        aux (R:ys) (rs,as,ms) = aux ys (R:rs,   as,   ms)
        aux (A:ys) (rs,as,ms) = aux ys (  rs, A:as,   ms)
        aux (M:ys) (rs,as,ms) = aux ys (  rs,   as, M:ms)

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

banderaTricolor5 :: [Color] -> [Color]
banderaTricolor5 = sort

-- Comprobación de equivalencia
-- ============================

instance Arbitrary Color where
  arbitrary = elements [A,R,M]

-- La propiedad es
prop_banderaTricolor :: [Color] -> Bool
prop_banderaTricolor xs =
  all (== banderaTricolor1 xs)
      [banderaTricolor2 xs,
       banderaTricolor3 xs,
       banderaTricolor4 xs,
       banderaTricolor5 xs]

verifica_banderaTricolor :: IO ()
verifica_banderaTricolor =
  quickCheck prop_banderaTricolor

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

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

-- La comparación es
--    λ> bandera n = concat [replicate n c | c <- [M,R,A]]
--    λ> length (banderaTricolor1 (bandera (10^6)))
--    3000000
--    (1.51 secs, 1,024,454,768 bytes)
--    λ> length (banderaTricolor1 (bandera (2*10^6)))
--    6000000
--    (2.94 secs, 2,048,454,832 bytes)
--    λ> length (banderaTricolor2 (bandera (2*10^6)))
--    6000000
--    (2.35 secs, 1,232,454,920 bytes)
--    λ> length (banderaTricolor3 (bandera (2*10^6)))
--    6000000
--    (4.28 secs, 2,304,455,360 bytes)
--    λ> length (banderaTricolor4 (bandera (2*10^6)))
--    6000000
--    (3.01 secs, 1,904,454,672 bytes)
--    λ> length (banderaTricolor5 (bandera (2*10^6)))
--    6000000
--    (2.47 secs, 1,248,454,744 bytes)

100

101

102

103

104

105

106

107

108

109

110

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

-- El problema de la bandera tricolor consiste en lo siguiente: Dada un

-- lista de objetos xs que pueden ser rojos, amarillos o morados, se pide

-- devolver una lista ys que contiene los elementos de xs, primero los

-- rojos, luego los amarillos y por último los morados.

-- Definir el tipo de dato Color para representar los colores con los

-- constructores R, A y M correspondientes al rojo, azul y morado y la

-- función

-- banderaTricolor :: [Color] -> [Color]

-- tal que (banderaTricolor xs) es la bandera tricolor formada con los

-- elementos de xs. Por ejemplo,

-- bandera [M,R,A,A,R,R,A,M,M] == [R,R,R,A,A,A,M,M,M]

-- bandera [M,R,A,R,R,A] == [R,R,R,A,A,M]

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

module Bandera_tricolor where

import Data.List (sort)

import Test.QuickCheck (Arbitrary(arbitrary), elements, quickCheck)

data Color = R | A | M

deriving (Show, Eq, Ord, Enum)

-- 1ª solución

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

banderaTricolor1 :: [Color] -> [Color]

banderaTricolor1 xs =

[x | x <- xs, x == R] ++

[x | x <- xs, x == A] ++

[x | x <- xs, x == M]

-- 2ª solución

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

banderaTricolor2 :: [Color] -> [Color]

banderaTricolor2 xs =

colores R ++ colores A ++ colores M

where colores c = filter (== c) xs

-- 3ª solución

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

banderaTricolor3 :: [Color] -> [Color]

banderaTricolor3 xs =

concat [[x | x <- xs, x == c] | c <- [R,A,M]]

-- 4ª solución

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

banderaTricolor4 :: [Color] -> [Color]

banderaTricolor4 xs = aux xs ([],[],[])

where aux [] (rs,as,ms) = rs ++ as ++ ms

aux (R:ys) (rs,as,ms) = aux ys (R:rs, as, ms)

aux (A:ys) (rs,as,ms) = aux ys ( rs, A:as, ms)

aux (M:ys) (rs,as,ms) = aux ys ( rs, as, M:ms)

-- 5ª solución

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

banderaTricolor5 :: [Color] -> [Color]

banderaTricolor5 = sort

-- Comprobación de equivalencia

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

instance Arbitrary Color where

arbitrary = elements [A,R,M]

-- La propiedad es

prop_banderaTricolor :: [Color] -> Bool

prop_banderaTricolor xs =

all (== banderaTricolor1 xs)

[banderaTricolor2 xs,

banderaTricolor3 xs,

banderaTricolor4 xs,

banderaTricolor5 xs]

verifica_banderaTricolor :: IO ()

verifica_banderaTricolor =

quickCheck prop_banderaTricolor

-- La comprobación es

-- λ> verifica_banderaTricolor

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> bandera n = concat [replicate n c | c <- [M,R,A]]

-- λ> length (banderaTricolor1 (bandera (10^6)))

-- 3000000

-- (1.51 secs, 1,024,454,768 bytes)

-- λ> length (banderaTricolor1 (bandera (2*10^6)))

-- 6000000

-- (2.94 secs, 2,048,454,832 bytes)

-- λ> length (banderaTricolor2 (bandera (2*10^6)))

-- 6000000

-- (2.35 secs, 1,232,454,920 bytes)

-- λ> length (banderaTricolor3 (bandera (2*10^6)))

-- 6000000

-- (4.28 secs, 2,304,455,360 bytes)

-- λ> length (banderaTricolor4 (bandera (2*10^6)))

-- 6000000

-- (3.01 secs, 1,904,454,672 bytes)

-- λ> length (banderaTricolor5 (bandera (2*10^6)))

-- 6000000

-- (2.47 secs, 1,248,454,744 bytes)

2. Anagramas

-- ---------------------------------------------------------------------
-- Una palabra es una anagrama de otra si se puede obtener permutando
-- sus letras. Por ejemplo, "mora" y "roma" son anagramas de "amor".
--
-- Definir la función
--    anagramas :: String -> [String] -> [String]
-- tal que (anagramas x ys) es la lista de los elementos de ys que son
-- anagramas de x. Por ejemplo,
--    λ> anagramas "amor" ["Roma","mola","loma","moRa", "rama"]
--    ["Roma","moRa"]
--    λ> anagramas "rama" ["aMar","amaRa","roMa","marr","aRma"]
--    ["aMar","aRma"]
-- ---------------------------------------------------------------------

module Anagramas where

import Data.List (delete, sort)
import Data.Char (toLower)
import Data.Function (on)

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

anagramas :: String -> [String] -> [String]
anagramas _ [] = []
anagramas x (y:ys)
  | sonAnagramas x y = y : anagramas x ys
  | otherwise        = anagramas x ys

-- (sonAnagramas xs ys) se verifica si xs e ys son anagramas. Por
-- ejemplo,
--    sonAnagramas "amor" "Roma"  ==  True
--    sonAnagramas "amor" "mola"  ==  False
sonAnagramas :: String -> String -> Bool
sonAnagramas xs ys =
  sort (map toLower xs) == sort (map toLower ys)

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

anagramas2 :: String -> [String] -> [String]
anagramas2 _ [] = []
anagramas2 x (y:ys)
  | sonAnagramas2 x y = y : anagramas2 x ys
  | otherwise         = anagramas2 x ys

sonAnagramas2 :: String -> String -> Bool
sonAnagramas2 xs ys =
  (sort . map toLower) xs == (sort . map toLower) ys

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

anagramas3 :: String -> [String] -> [String]
anagramas3 _ [] = []
anagramas3 x (y:ys)
  | sonAnagramas3 x y = y : anagramas3 x ys
  | otherwise         = anagramas3 x ys

sonAnagramas3 :: String -> String -> Bool
sonAnagramas3 = (==) `on` (sort . map toLower)

-- Nota. En la solución anterior se usa la función on ya que
--    (f `on` g) x y
-- es equivalente a
--    f (g x) (g y)
-- Por ejemplo,
--    λ> ((*) `on` (+2)) 3 4
--    30

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

anagramas4 :: String -> [String] -> [String]
anagramas4 x ys = [y | y <- ys, sonAnagramas x y]

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

anagramas5 :: String -> [String] -> [String]
anagramas5 x = filter (`sonAnagramas` x)

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

anagramas6 :: String -> [String] -> [String]
anagramas6 x = filter (((==) `on` (sort . map toLower)) x)

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

anagramas7 :: String -> [String] -> [String]
anagramas7 _ [] = []
anagramas7 x (y:ys)
  | sonAnagramas7 x y = y : anagramas7 x ys
  | otherwise         = anagramas7 x ys

sonAnagramas7 :: String -> String -> Bool
sonAnagramas7 xs ys = aux (map toLower xs) (map toLower ys)
  where
    aux [] [] = True
    aux [] _  = False
    aux (u:us) vs | u `notElem` vs = False
                  | otherwise      = aux us (delete u vs)

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

-- La comparación es
--    λ> ej = take (10^6) (permutations "1234567890")
--    λ> length (anagramas "1234567890" ej)
--    1000000
--    (2.27 secs, 5,627,236,104 bytes)
--    λ> length (anagramas2 "1234567890" ej)
--    1000000
--    (2.80 secs, 5,513,260,584 bytes)
--    λ> length (anagramas3 "1234567890" ej)
--    1000000
--    (1.86 secs, 5,097,260,856 bytes)
--    λ> length (anagramas4 "1234567890" ej)
--    1000000
--    (2.25 secs, 5,073,260,632 bytes)
--    λ> length (anagramas5 "1234567890" ej)
--    1000000
--    (2.14 secs, 5,009,260,616 bytes)
--    λ> length (anagramas6 "1234567890" ej)
--    1000000
--    (1.58 secs, 4,977,260,976 bytes)
--    λ> length (anagramas7 "1234567890" ej)
--    1000000
--    (6.63 secs, 6,904,821,648 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

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

-- Una palabra es una anagrama de otra si se puede obtener permutando

-- sus letras. Por ejemplo, "mora" y "roma" son anagramas de "amor".

-- Definir la función

-- anagramas :: String -> [String] -> [String]

-- tal que (anagramas x ys) es la lista de los elementos de ys que son

-- anagramas de x. Por ejemplo,

-- λ> anagramas "amor" ["Roma","mola","loma","moRa", "rama"]

-- ["Roma","moRa"]

-- λ> anagramas "rama" ["aMar","amaRa","roMa","marr","aRma"]

-- ["aMar","aRma"]

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

module Anagramas where

import Data.List (delete, sort)

import Data.Char (toLower)

import Data.Function (on)

-- 1ª solución

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

anagramas :: String -> [String] -> [String]

anagramas _ [] = []

anagramas x (y:ys)

| sonAnagramas x y = y : anagramas x ys

| otherwise = anagramas x ys

-- (sonAnagramas xs ys) se verifica si xs e ys son anagramas. Por

-- ejemplo,

-- sonAnagramas "amor" "Roma" == True

-- sonAnagramas "amor" "mola" == False

sonAnagramas :: String -> String -> Bool

sonAnagramas xs ys =

sort (map toLower xs) == sort (map toLower ys)

-- 2ª solución

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

anagramas2 :: String -> [String] -> [String]

anagramas2 _ [] = []

anagramas2 x (y:ys)

| sonAnagramas2 x y = y : anagramas2 x ys

| otherwise = anagramas2 x ys

sonAnagramas2 :: String -> String -> Bool

sonAnagramas2 xs ys =

(sort . map toLower) xs == (sort . map toLower) ys

-- 3ª solución

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

anagramas3 :: String -> [String] -> [String]

anagramas3 _ [] = []

anagramas3 x (y:ys)

| sonAnagramas3 x y = y : anagramas3 x ys

| otherwise = anagramas3 x ys

sonAnagramas3 :: String -> String -> Bool

sonAnagramas3 = (==) `on` (sort . map toLower)

-- Nota. En la solución anterior se usa la función on ya que

-- (f `on` g) x y

-- es equivalente a

-- f (g x) (g y)

-- Por ejemplo,

-- λ> ((*) `on` (+2)) 3 4

-- 30

-- 4ª solución

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

anagramas4 :: String -> [String] -> [String]

anagramas4 x ys = [y | y <- ys, sonAnagramas x y]

-- 5ª solución

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

anagramas5 :: String -> [String] -> [String]

anagramas5 x = filter (`sonAnagramas` x)

-- 6ª solución

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

anagramas6 :: String -> [String] -> [String]

anagramas6 x = filter (((==) `on` (sort . map toLower)) x)

-- 7ª solución

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

anagramas7 :: String -> [String] -> [String]

anagramas7 _ [] = []

anagramas7 x (y:ys)

| sonAnagramas7 x y = y : anagramas7 x ys

| otherwise = anagramas7 x ys

sonAnagramas7 :: String -> String -> Bool

sonAnagramas7 xs ys = aux (map toLower xs) (map toLower ys)

where

aux [] [] = True

aux [] _ = False

aux (u:us) vs | u `notElem` vs = False

| otherwise = aux us (delete u vs)

-- Comparación de eficiencia

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

-- La comparación es

-- λ> ej = take (10^6) (permutations "1234567890")

-- λ> length (anagramas "1234567890" ej)

-- 1000000

-- (2.27 secs, 5,627,236,104 bytes)

-- λ> length (anagramas2 "1234567890" ej)

-- 1000000

-- (2.80 secs, 5,513,260,584 bytes)

-- λ> length (anagramas3 "1234567890" ej)

-- 1000000

-- (1.86 secs, 5,097,260,856 bytes)

-- λ> length (anagramas4 "1234567890" ej)

-- 1000000

-- (2.25 secs, 5,073,260,632 bytes)

-- λ> length (anagramas5 "1234567890" ej)

-- 1000000

-- (2.14 secs, 5,009,260,616 bytes)

-- λ> length (anagramas6 "1234567890" ej)

-- 1000000

-- (1.58 secs, 4,977,260,976 bytes)

-- λ> length (anagramas7 "1234567890" ej)

-- 1000000

-- (6.63 secs, 6,904,821,648 bytes)

3. Primos equidistantes

-- ---------------------------------------------------------------------
-- Definir la función
--    primosEquidistantes :: Integer -> [(Integer,Integer)]
-- tal que (primosEquidistantes k) es la lista de los pares de primos
-- cuya diferencia es k. Por ejemplo,
--    take 3 (primosEquidistantes 2)  ==  [(3,5),(5,7),(11,13)]
--    take 3 (primosEquidistantes 4)  ==  [(7,11),(13,17),(19,23)]
--    take 3 (primosEquidistantes 6)  ==  [(23,29),(31,37),(47,53)]
--    take 3 (primosEquidistantes 8)  ==  [(89,97),(359,367),(389,397)]
--    primosEquidistantes 4 !! (10^5) ==  (18467047,18467051)
-- ---------------------------------------------------------------------

{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}

module Primos_equidistantes where

import Data.Numbers.Primes (primes)

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

primosEquidistantes1 :: Integer -> [(Integer,Integer)]
primosEquidistantes1 k = aux primos
  where aux (x:y:ps) | y - x == k = (x,y) : aux (y:ps)
                     | otherwise  = aux (y:ps)

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

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

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

primosEquidistantes2 :: Integer -> [(Integer,Integer)]
primosEquidistantes2 k = aux primos2
  where aux (x:y:ps) | y - x == k = (x,y) : aux (y:ps)
                     | otherwise  = aux (y:ps)

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

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

primosEquidistantes3 :: Integer -> [(Integer,Integer)]
primosEquidistantes3 k = aux primos3
  where aux (x:y:ps) | y - x == k = (x,y) : aux (y:ps)
                     | otherwise  = aux (y:ps)

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

primosEquidistantes4 :: Integer -> [(Integer,Integer)]
primosEquidistantes4 k = aux primes
  where aux (x:y:ps) | y - x == k = (x,y) : aux (y:ps)
                     | otherwise  = aux (y:ps)

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

primosEquidistantes5 :: Integer -> [(Integer,Integer)]
primosEquidistantes5 k =
  [(x,y) | (x,y) <- zip primes (tail primes)
         , y - x == k]

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

-- La comparación es
--    λ> primosEquidistantes1 4 !! 200
--    (9829,9833)
--    (2.60 secs, 1,126,458,272 bytes)
--    λ> primosEquidistantes2 4 !! 200
--    (9829,9833)
--    (0.44 secs, 249,622,048 bytes)
--    λ> primosEquidistantes3 4 !! 200
--    (9829,9833)
--    (0.06 secs, 13,352,208 bytes)
--    λ> primosEquidistantes4 4 !! 200
--    (9829,9833)
--    (0.02 secs, 4,012,848 bytes)
--    λ> primosEquidistantes5 4 !! 200
--    (9829,9833)
--    (0.01 secs, 7,085,072 bytes)
--
--    λ> primosEquidistantes2 4 !! 600
--    (41617,41621)
--    (5.67 secs, 3,340,313,480 bytes)
--    λ> primosEquidistantes3 4 !! 600
--    (41617,41621)
--    (0.14 secs, 76,600,968 bytes)
--    λ> primosEquidistantes4 4 !! 600
--    (41617,41621)
--    (0.03 secs, 15,465,824 bytes)
--    λ> primosEquidistantes5 4 !! 600
--    (41617,41621)
--    (0.04 secs, 28,858,232 bytes)
--
--    λ> primosEquidistantes3 4 !! 5000
--    (556819,556823)
--    (3.58 secs, 2,040,940,144 bytes)
--    λ> primosEquidistantes4 4 !! 5000
--    (556819,556823)
--    (0.12 secs, 220,705,192 bytes)
--    λ> primosEquidistantes5 4 !! 5000
--    (556819,556823)
--    (0.16 secs, 424,501,800 bytes)
--
--    λ> primosEquidistantes4 4 !! (10^5)
--    (18467047,18467051)
--    (3.99 secs, 9,565,715,488 bytes)
--    λ> primosEquidistantes5 4 !! (10^5)
--    (18467047,18467051)
--    (7.95 secs, 18,712,469,144 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

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

-- Definir la función

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

-- tal que (primosEquidistantes k) es la lista de los pares de primos

-- cuya diferencia es k. Por ejemplo,

-- take 3 (primosEquidistantes 2) == [(3,5),(5,7),(11,13)]

-- take 3 (primosEquidistantes 4) == [(7,11),(13,17),(19,23)]

-- take 3 (primosEquidistantes 6) == [(23,29),(31,37),(47,53)]

-- take 3 (primosEquidistantes 8) == [(89,97),(359,367),(389,397)]

-- primosEquidistantes 4 !! (10^5) == (18467047,18467051)

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

{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}

module Primos_equidistantes where

import Data.Numbers.Primes (primes)

-- 1ª solución

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

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

primosEquidistantes1 k = aux primos

where aux (x:y:ps) | y - x == k = (x,y) : aux (y:ps)

| otherwise = aux (y:ps)

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

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

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

primos :: [Integer]

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

-- 2ª solución

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

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

primosEquidistantes2 k = aux primos2

where aux (x:y:ps) | y - x == k = (x,y) : aux (y:ps)

| otherwise = aux (y:ps)

primos2 :: [Integer]

primos2 = criba [2..]

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

-- 3ª solución

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

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

primosEquidistantes3 k = aux primos3

where aux (x:y:ps) | y - x == k = (x,y) : aux (y:ps)

| otherwise = aux (y:ps)

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

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

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

primosEquidistantes4 k = aux primes

where aux (x:y:ps) | y - x == k = (x,y) : aux (y:ps)

| otherwise = aux (y:ps)

-- 5ª solución

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

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

primosEquidistantes5 k =

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

, y - x == k]

-- Comparación de eficiencia

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

-- La comparación es

-- λ> primosEquidistantes1 4 !! 200

-- (9829,9833)

-- (2.60 secs, 1,126,458,272 bytes)

-- λ> primosEquidistantes2 4 !! 200

-- (9829,9833)

-- (0.44 secs, 249,622,048 bytes)

-- λ> primosEquidistantes3 4 !! 200

-- (9829,9833)

-- (0.06 secs, 13,352,208 bytes)

-- λ> primosEquidistantes4 4 !! 200

-- (9829,9833)

-- (0.02 secs, 4,012,848 bytes)

-- λ> primosEquidistantes5 4 !! 200

-- (9829,9833)

-- (0.01 secs, 7,085,072 bytes)

-- λ> primosEquidistantes2 4 !! 600

-- (41617,41621)

-- (5.67 secs, 3,340,313,480 bytes)

-- λ> primosEquidistantes3 4 !! 600

-- (41617,41621)

-- (0.14 secs, 76,600,968 bytes)

-- λ> primosEquidistantes4 4 !! 600

-- (41617,41621)

-- (0.03 secs, 15,465,824 bytes)

-- λ> primosEquidistantes5 4 !! 600

-- (41617,41621)

-- (0.04 secs, 28,858,232 bytes)

-- λ> primosEquidistantes3 4 !! 5000

-- (556819,556823)

-- (3.58 secs, 2,040,940,144 bytes)

-- λ> primosEquidistantes4 4 !! 5000

-- (556819,556823)

-- (0.12 secs, 220,705,192 bytes)

-- λ> primosEquidistantes5 4 !! 5000

-- (556819,556823)

-- (0.16 secs, 424,501,800 bytes)

-- λ> primosEquidistantes4 4 !! (10^5)

-- (18467047,18467051)

-- (3.99 secs, 9,565,715,488 bytes)

-- λ> primosEquidistantes5 4 !! (10^5)

-- (18467047,18467051)

-- (7.95 secs, 18,712,469,144 bytes)

4. Suma si todos los valores son justos

-- ---------------------------------------------------------------------
-- Definir la función
--    sumaSiTodosJustos :: (Num a, Eq a) => [Maybe a] -> Maybe a
-- tal que (sumaSiTodosJustos xs) es justo la suma de todos los
-- elementos de xs si todos son justos (es decir, si Nothing no
-- pertenece a xs) y Nothing en caso contrario. Por ejemplo,
--    sumaSiTodosJustos [Just 2, Just 5]           == Just 7
--    sumaSiTodosJustos [Just 2, Just 5, Nothing]  == Nothing
-- ---------------------------------------------------------------------

module Suma_si_todos_justos where

import Data.Maybe (catMaybes, isJust, fromJust)
import Test.QuickCheck (quickCheck)

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

sumaSiTodosJustos1 :: (Num a, Eq a) => [Maybe a] -> Maybe a
sumaSiTodosJustos1 xs
  | todosJustos xs = Just (sum [x | (Just x) <- xs])
  | otherwise      = Nothing

-- (todosJustos xs) se verifica si todos los elementos de xs son justos
-- (es decir, si Nothing no pertenece a xs) y Nothing en caso
-- contrario. Por ejemplo,
--    todosJustos [Just 2, Just 5]           == True
--    todosJustos [Just 2, Just 5, Nothing]  == False

-- 1ª definición de todosJustos:
todosJustos1 :: Eq a => [Maybe a] -> Bool
todosJustos1 = notElem Nothing

-- 2ª definición de todosJustos:
todosJustos :: Eq a => [Maybe a] -> Bool
todosJustos = all isJust

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

sumaSiTodosJustos2 :: (Num a, Eq a) => [Maybe a] -> Maybe a
sumaSiTodosJustos2 xs
  | todosJustos xs = Just (sum [fromJust x | x <- xs])
  | otherwise      = Nothing

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

sumaSiTodosJustos3 :: (Num a, Eq a) => [Maybe a] -> Maybe a
sumaSiTodosJustos3 xs
  | todosJustos xs = Just (sum (map fromJust xs))
  | otherwise      = Nothing

-- 4ª solución

sumaSiTodosJustos4 :: (Num a, Eq a) => [Maybe a] -> Maybe a
sumaSiTodosJustos4 xs
  | todosJustos xs = Just (sum (catMaybes xs))
  | otherwise      = Nothing

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

sumaSiTodosJustos5 :: (Num a, Eq a) => [Maybe a] -> Maybe a
sumaSiTodosJustos5 xs = suma (sequence xs)
  where suma Nothing   = Nothing
        suma (Just ys) = Just (sum ys)

-- Nota. En la solución anterior se usa la función
--    sequence :: Monad m => [m a] -> m [a]
-- tal que (sequence xs) es la mónada obtenida evaluando cada una de las
-- de xs de izquierda a derecha. Por ejemplo,
--    sequence [Just 2, Just 5]   ==  Just [2,5]
--    sequence [Just 2, Nothing]  ==  Nothing
--    sequence [[2,4],[5,7]]      ==  [[2,5],[2,7],[4,5],[4,7]]
--    sequence [[2,4],[5,7],[6]]  ==  [[2,5,6],[2,7,6],[4,5,6],[4,7,6]]
--    sequence [[2,4],[5,7],[]]   ==  []

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

sumaSiTodosJustos6 :: (Num a, Eq a) => [Maybe a] -> Maybe a
sumaSiTodosJustos6 xs = fmap sum (sequence xs)

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

sumaSiTodosJustos7 :: (Num a, Eq a) => [Maybe a] -> Maybe a
sumaSiTodosJustos7 = fmap sum . sequence

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

-- La propiedad es
prop_sumaSiTodosJustos :: [Maybe Integer] -> Bool
prop_sumaSiTodosJustos xs =
  all (== sumaSiTodosJustos1 xs)
      [sumaSiTodosJustos2 xs,
       sumaSiTodosJustos3 xs,
       sumaSiTodosJustos4 xs,
       sumaSiTodosJustos5 xs,
       sumaSiTodosJustos6 xs,
       sumaSiTodosJustos7 xs]

verifica_sumaSiTodosJustos :: IO ()
verifica_sumaSiTodosJustos =
  quickCheck prop_sumaSiTodosJustos

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

100

101

102

103

104

105

106

107

108

109

110

111

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

-- Definir la función

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

-- tal que (sumaSiTodosJustos xs) es justo la suma de todos los

-- elementos de xs si todos son justos (es decir, si Nothing no

-- pertenece a xs) y Nothing en caso contrario. Por ejemplo,

-- sumaSiTodosJustos [Just 2, Just 5] == Just 7

-- sumaSiTodosJustos [Just 2, Just 5, Nothing] == Nothing

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

module Suma_si_todos_justos where

import Data.Maybe (catMaybes, isJust, fromJust)

import Test.QuickCheck (quickCheck)

-- 1ª solución

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

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

sumaSiTodosJustos1 xs

| todosJustos xs = Just (sum [x | (Just x) <- xs])

| otherwise = Nothing

-- (todosJustos xs) se verifica si todos los elementos de xs son justos

-- (es decir, si Nothing no pertenece a xs) y Nothing en caso

-- contrario. Por ejemplo,

-- todosJustos [Just 2, Just 5] == True

-- todosJustos [Just 2, Just 5, Nothing] == False

-- 1ª definición de todosJustos:

todosJustos1 :: Eq a => [Maybe a] -> Bool

todosJustos1 = notElem Nothing

-- 2ª definición de todosJustos:

todosJustos :: Eq a => [Maybe a] -> Bool

todosJustos = all isJust

-- 2ª solución

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

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

sumaSiTodosJustos2 xs

| todosJustos xs = Just (sum [fromJust x | x <- xs])

| otherwise = Nothing

-- 3ª solución

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

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

sumaSiTodosJustos3 xs

| todosJustos xs = Just (sum (map fromJust xs))

| otherwise = Nothing

-- 4ª solución

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

sumaSiTodosJustos4 xs

| todosJustos xs = Just (sum (catMaybes xs))

| otherwise = Nothing

-- 5ª solución

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

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

sumaSiTodosJustos5 xs = suma (sequence xs)

where suma Nothing = Nothing

suma (Just ys) = Just (sum ys)

-- Nota. En la solución anterior se usa la función

-- sequence :: Monad m => [m a] -> m [a]

-- tal que (sequence xs) es la mónada obtenida evaluando cada una de las

-- de xs de izquierda a derecha. Por ejemplo,

-- sequence [Just 2, Just 5] == Just [2,5]

-- sequence [Just 2, Nothing] == Nothing

-- sequence [[2,4],[5,7]] == [[2,5],[2,7],[4,5],[4,7]]

-- sequence [[2,4],[5,7],[6]] == [[2,5,6],[2,7,6],[4,5,6],[4,7,6]]

-- sequence [[2,4],[5,7],[]] == []

-- 6ª solución

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

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

sumaSiTodosJustos6 xs = fmap sum (sequence xs)

-- 7ª solución

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

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

sumaSiTodosJustos7 = fmap sum . sequence

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_sumaSiTodosJustos :: [Maybe Integer] -> Bool

prop_sumaSiTodosJustos xs =

all (== sumaSiTodosJustos1 xs)

[sumaSiTodosJustos2 xs,

sumaSiTodosJustos3 xs,

sumaSiTodosJustos4 xs,

sumaSiTodosJustos5 xs,

sumaSiTodosJustos6 xs,

sumaSiTodosJustos7 xs]

verifica_sumaSiTodosJustos :: IO ()

verifica_sumaSiTodosJustos =

quickCheck prop_sumaSiTodosJustos

-- La comprobación es

-- λ> verifica_sumaSiTodosJustos

-- +++ OK, passed 100 tests.

5. Posiciones de las diagonales principales

-- ---------------------------------------------------------------------
-- Las posiciones de una matriz con 3 filas y 4 columnas son
--    (1,1) (1,2) (1,3) (1,4)
--    (2,1) (2,2) (2,3) (2,4)
--    (3,1) (3,2) (3,3) (3,4)
-- La posiciones de sus 6 diagonales principales son
--   [(3,1)]
--   [(2,1),(3,2)]
--   [(1,1),(2,2),(3,3)]
--   [(1,2),(2,3),(3,4)]
--   [(1,3),(2,4)]
--   [(1,4)]
--
-- Definir la función
--    posicionesDiagonalesPrincipales :: Int -> Int -> [[(Int, Int)]]
-- tal que (posicionesdiagonalesprincipales m n) es la lista de las
-- posiciones de las diagonales principales de una matriz con m filas y
-- n columnas. Por ejemplo,
--   λ> mapM_ print (posicionesDiagonalesPrincipales 3 4)
--   [(3,1)]
--   [(2,1),(3,2)]
--   [(1,1),(2,2),(3,3)]
--   [(1,2),(2,3),(3,4)]
--   [(1,3),(2,4)]
--   [(1,4)]
--   λ> mapM_ print (posicionesDiagonalesPrincipales 4 4)
--   [(4,1)]
--   [(3,1),(4,2)]
--   [(2,1),(3,2),(4,3)]
--   [(1,1),(2,2),(3,3),(4,4)]
--   [(1,2),(2,3),(3,4)]
--   [(1,3),(2,4)]
--   [(1,4)]
--   λ> mapM_ print (posicionesDiagonalesPrincipales 4 3)
--   [(4,1)]
--   [(3,1),(4,2)]
--   [(2,1),(3,2),(4,3)]
--   [(1,1),(2,2),(3,3)]
--   [(1,2),(2,3)]
--   [(1,3)]
-- ---------------------------------------------------------------------

module Posiciones_diagonales_principales where

import Test.QuickCheck

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

posicionesDiagonalesPrincipales1 :: Int -> Int -> [[(Int, Int)]]
posicionesDiagonalesPrincipales1 m n =
  [extension ij | ij <- iniciales]
  where iniciales = [(i,1) | i <- [m,m-1..2]] ++ [(1,j) | j <- [1..n]]
        extension (i,j) = [(i+k,j+k) | k <- [0..min (m-i) (n-j)]]

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

posicionesDiagonalesPrincipales2 :: Int -> Int -> [[(Int, Int)]]
posicionesDiagonalesPrincipales2 m n =
  [zip [i..m] [1..n] | i <- [m,m-1..1]] ++
  [zip [1..m] [j..n] | j <- [2..n]]

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

-- La propiedad es
prop_posicionesDiagonalesPrincipales :: Positive Int -> Positive Int -> Bool
prop_posicionesDiagonalesPrincipales (Positive m) (Positive n) =
  posicionesDiagonalesPrincipales1 m n ==
  posicionesDiagonalesPrincipales2 m n

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

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

-- La comparación es
--   λ> length (posicionesDiagonalesPrincipales1 (10^7) (10^6))
--   10999999
--   (6.14 secs, 3,984,469,440 bytes)
--   λ> length (posicionesDiagonalesPrincipales2 (10^7) (10^6))
--   10999999
--   (3.07 secs, 2,840,469,440 bytes)

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

-- Las posiciones de una matriz con 3 filas y 4 columnas son

-- (1,1) (1,2) (1,3) (1,4)

-- (2,1) (2,2) (2,3) (2,4)

-- (3,1) (3,2) (3,3) (3,4)

-- La posiciones de sus 6 diagonales principales son

-- [(3,1)]

-- [(2,1),(3,2)]

-- [(1,1),(2,2),(3,3)]

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

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

-- [(1,4)]

-- Definir la función

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

-- tal que (posicionesdiagonalesprincipales m n) es la lista de las

-- posiciones de las diagonales principales de una matriz con m filas y

-- n columnas. Por ejemplo,

-- λ> mapM_ print (posicionesDiagonalesPrincipales 3 4)

-- [(3,1)]

-- [(2,1),(3,2)]

-- [(1,1),(2,2),(3,3)]

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

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

-- [(1,4)]

-- λ> mapM_ print (posicionesDiagonalesPrincipales 4 4)

-- [(4,1)]

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

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

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

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

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

-- [(1,4)]

-- λ> mapM_ print (posicionesDiagonalesPrincipales 4 3)

-- [(4,1)]

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

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

-- [(1,1),(2,2),(3,3)]

-- [(1,2),(2,3)]

-- [(1,3)]

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

module Posiciones_diagonales_principales where

import Test.QuickCheck

-- 1ª solución

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

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

posicionesDiagonalesPrincipales1 m n =

[extension ij | ij <- iniciales]

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

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

-- 2ª solución

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

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

posicionesDiagonalesPrincipales2 m n =

[zip [i..m] [1..n] | i <- [m,m-1..1]] ++

[zip [1..m] [j..n] | j <- [2..n]]

-- Equivalencia de las definiciones

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

-- La propiedad es

prop_posicionesDiagonalesPrincipales :: Positive Int -> Positive Int -> Bool

prop_posicionesDiagonalesPrincipales (Positive m) (Positive n) =

posicionesDiagonalesPrincipales1 m n ==

posicionesDiagonalesPrincipales2 m n

-- La comprobación es

-- λ> quickCheck prop_posicionesDiagonalesPrincipales

-- +++ OK, passed 100 tests.

-- Comparación de eficiencia

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

-- La comparación es

-- λ> length (posicionesDiagonalesPrincipales1 (10^7) (10^6))

-- 10999999

-- (6.14 secs, 3,984,469,440 bytes)

-- λ> length (posicionesDiagonalesPrincipales2 (10^7) (10^6))

-- 10999999

-- (3.07 secs, 2,840,469,440 bytes)

1. La bandera tricolor

2. Anagramas

3. Primos equidistantes

4. Suma si todos los valores son justos

5. Posiciones de las diagonales principales

Se puede imprimir o compartir con