Recursión

Primos equidistantes

PorJosé A. Alonso 2-marzo-202215-abril-2022

Definir la función

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

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

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)

Soluciones

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 =
  [(x,y) | (x,y) <- zip primos2 (tail primos2)
         , y - x == k]

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

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

-- La propiedad es
prop_primosEquidistantes :: Int -> Integer -> Bool
prop_primosEquidistantes n k =
  all (== take n (primosEquidistantes1 k))
      [take n (f k) | f <- [primosEquidistantes2,
                            primosEquidistantes3,
                            primosEquidistantes4,
                            primosEquidistantes5]]

-- La comprobación es
--    λ> prop_primosEquidistantes 100 4
--    True

-- 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.36 secs, 207,549,592 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)
--    (5.43 secs, 3,090,994,096 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)
--
--    λ> 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

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 =

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

, y - x == k]

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

-- Comprobación de equivalencia

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

-- La propiedad es

prop_primosEquidistantes :: Int -> Integer -> Bool

prop_primosEquidistantes n k =

all (== take n (primosEquidistantes1 k))

[take n (f k) | f <- [primosEquidistantes2,

primosEquidistantes3,

primosEquidistantes4,

primosEquidistantes5]]

-- La comprobación es

-- λ> prop_primosEquidistantes 100 4

-- True

-- 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.36 secs, 207,549,592 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)

-- (5.43 secs, 3,090,994,096 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)

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

El código se encuentra en GitHub.

Anagramas

PorJosé A. Alonso 1-marzo-20228-marzo-2022

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]

1	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"]

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

["Roma","moRa"]

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

["aMar","aRma"]

Soluciones

import Data.List (delete, permutations, 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

import Data.List (delete, permutations, 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)

El código se encuentra en GitHub.

La bandera tricolor

PorJosé A. Alonso 28-febrero-20227-marzo-2022

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]

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

1 2	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]

Soluciones

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)

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)

El código se encuentra en GitHub.

Iguales al siguiente

PorJosé A. Alonso 24-febrero-20223-marzo-2022

Definir la función

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

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

1 2	igualesAlSiguiente [1,2,2,2,3,3,4] == [2,2,3] igualesAlSiguiente [1..10] == []

Soluciones

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

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)

El código se encuentra en GitHub.

Primos consecutivos con media capicúa

PorJosé A. Alonso 23-febrero-202215-abril-2022

Definir la lista

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

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

λ> take 5 primosConsecutivosConMediaCapicua

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

λ> primosConsecutivosConMediaCapicua !! 500

(5687863,5687867,5687865)

Soluciones

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]
        criba []     = error "Imposible"

-- 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)
        criba3 _ [] _     = error "Imposible"

-- 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 {-# SCC "" #-}
--    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

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]

criba [] = error "Imposible"

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

criba3 _ [] _ = error "Imposible"

-- 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 {-# SCC "" #-}

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

El código se encuentra en GitHub.

Primos equidistantes

Soluciones

Anagramas

Soluciones

La bandera tricolor

Soluciones

Iguales al siguiente

Soluciones

Primos consecutivos con media capicúa

Soluciones

Entradas recientes

Buscar

Correo electrónico