Menu Close

Etiqueta: Mónadas

Iguales al siguiente

José A. Alonso, ,

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

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)

El código se encuentra en GitHub.

Leer más →

Primos consecutivos con media capicúa

José A. Alonso, ,

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)

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)

El código se encuentra en GitHub.

Leer más →

Duplicación de cada elemento

José A. Alonso, ,

Definir la función

   duplicaElementos :: [a] -> [a]

tal que (duplicaElementos xs) es la lista obtenida duplicando cada elemento de xs. Por ejemplo,

   duplicaElementos1 [3,2,5]    ==  [3,3,2,2,5,5]
   duplicaElementos1 "Haskell"  ==  "HHaasskkeellll"

Soluciones

import Test.QuickCheck
 
--  1ª solución
duplicaElementos1 :: [a] -> [a]
duplicaElementos1 [] = []
duplicaElementos1 (x:xs) = x : x : duplicaElementos1 xs
 
-- 2 solución
duplicaElementos2 :: [a] -> [a]
duplicaElementos2 = foldr (\x ys -> x:x:ys) []
 
-- 3ª solución
duplicaElementos3 :: [a] -> [a]
duplicaElementos3 xs = concat [[x,x] | x <- xs]
 
-- 4ª solución
duplicaElementos4 :: [a] -> [a]
duplicaElementos4 xs = concat (map (replicate 2) xs)
 
-- 5ª solución
duplicaElementos5 :: [a] -> [a]
duplicaElementos5 = concatMap (replicate 2)
 
-- 6ª solución
duplicaElementos6 :: [a] -> [a]
duplicaElementos6 = (>>= replicate 2)
 
-- Equivalencia de las definiciones
-- ================================
 
-- La propiedad es
prop_duplicaElementos :: [Int] -> Bool
prop_duplicaElementos xs =
  all (== (duplicaElementos1 xs))
      [f xs | f <- [duplicaElementos2,
                    duplicaElementos3,
                    duplicaElementos4,
                    duplicaElementos5,
                    duplicaElementos6]]
 
-- La comprobación es
--    λ> quickCheck prop_duplicaElementos
--    +++ OK, passed 100 tests.

El código se encuentra en GitHub.

Leer más →