Menu Close

Etiqueta: Data.Char

Números con todos sus dígitos primos

Definir la lista

   numerosConDigitosPrimos :: [Integer]

cuyos elementos son los números con todos sus dígitos primos. Por ejemplo,

   λ> take 22 numerosConDigitosPrimos
   [2,3,5,7,22,23,25,27,32,33,35,37,52,53,55,57,72,73,75,77,222,223]
   λ> numerosConDigitosPrimos !! (10^7)
   322732232572

Soluciones

module Numeros_con_digitos_primos where
 
import Test.QuickCheck (NonNegative (NonNegative), quickCheck)
import Data.Char (intToDigit)
 
-- 1ª solución
-- ===========
 
numerosConDigitosPrimos1 :: [Integer]
numerosConDigitosPrimos1 = [n | n <- [2..], digitosPrimos n]
 
-- (digitosPrimos n) se verifica si todos los dígitos de n son
-- primos. Por ejemplo,
--    digitosPrimos 352  ==  True
--    digitosPrimos 362  ==  False
digitosPrimos :: Integer -> Bool
digitosPrimos n = subconjunto (digitos n) [2,3,5,7]
 
-- (digitos n) es la lista de las digitos de n. Por ejemplo,
--    digitos 325  ==  [3,2,5]
digitos :: Integer -> [Integer]
digitos n = [read [x] | x <- show n]
 
-- (subconjunto xs ys) se verifica si xs es un subconjunto de ys. Por
-- ejemplo,
--    subconjunto [3,2,5,2] [2,7,3,5]  ==  True
--    subconjunto [3,2,5,2] [2,7,2,5]  ==  False
subconjunto :: Eq a => [a] -> [a] -> Bool
subconjunto xs ys = and [x `elem` ys | x <- xs]
 
-- 2ª solución
-- ===========
 
numerosConDigitosPrimos2 :: [Integer]
numerosConDigitosPrimos2 =
  filter (all (`elem` "2357") . show) [2..]
 
-- 3ª solución
-- ===========
 
--    λ> take 60 numerosConDigitosPrimos2
--    [  2,  3,  5,  7,
--      22, 23, 25, 27,
--      32, 33, 35, 37,
--      52, 53, 55, 57,
--      72, 73, 75, 77,
--     222,223,225,227,
--     232,233,235,237,
--     252,253,255,257,
--     272,273,275,277,
--     322,323,325,327,
--     332,333,335,337,
--     352,353,355,357,
--     372,373,375,377,
--     522,523,525,527,
--     532,533,535,537]
 
numerosConDigitosPrimos3 :: [Integer]
numerosConDigitosPrimos3 =
  [2,3,5,7] ++ [10*n+d | n <- numerosConDigitosPrimos3, d <- [2,3,5,7]]
 
-- 4ª solución
-- ===========
 
--    λ> take 60 numerosConDigitosPrimos2
--    [ 2, 3, 5, 7,
--     22,23,25,27,
--     32,33,35,37,
--     52,53,55,57,
--     72,73,75,77,
--     222,223,225,227, 232,233,235,237, 252,253,255,257, 272,273,275,277,
--     322,323,325,327, 332,333,335,337, 352,353,355,357, 372,373,375,377,
--     522,523,525,527, 532,533,535,537]
 
numerosConDigitosPrimos4 :: [Integer]
numerosConDigitosPrimos4 = concat (iterate siguiente [2,3,5,7])
 
-- (siguiente xs) es la lista obtenida añadiendo delante de cada
-- elemento de xs los dígitos 2, 3, 5 y 7. Por ejemplo,
--    λ> siguiente [5,6,8]
--    [25,26,28,
--     35,36,38,
--     55,56,58,
--     75,76,78]
siguiente :: [Integer] -> [Integer]
siguiente xs = concat [map (pega d) xs | d <- [2,3,5,7]]
 
-- (pega d n) es el número obtenido añadiendo el dígito d delante del
-- número n. Por ejemplo,
--    pega 3 35  ==  335
pega :: Int -> Integer -> Integer
pega d n = read (intToDigit d : show n)
 
-- Comprobación de equivalencia
-- ============================
 
-- La propiedad es
prop_numerosConDigitosPrimos :: NonNegative Int -> Bool
prop_numerosConDigitosPrimos (NonNegative n) =
  all (== numerosConDigitosPrimos1 !! n)
      [ numerosConDigitosPrimos2 !! n
      , numerosConDigitosPrimos3 !! n
      , numerosConDigitosPrimos4 !! n
      ]
 
-- La comprobación es
--    λ> quickCheck prop_numerosConDigitosPrimos
--    +++ OK, passed 100 tests.
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> numerosConDigitosPrimos1 !! 5000
--    752732
--    (2.45 secs, 6,066,926,272 bytes)
--    λ> numerosConDigitosPrimos2 !! 5000
--    752732
--    (0.34 secs, 387,603,456 bytes)
--    λ> numerosConDigitosPrimos3 !! 5000
--    752732
--    (0.01 secs, 1,437,624 bytes)
--    λ> numerosConDigitosPrimos4 !! 5000
--    752732
--    (0.00 secs, 1,556,104 bytes)
--
--    λ> numerosConDigitosPrimos3 !! (10^7)
--    322732232572
--    (3.94 secs, 1,820,533,328 bytes)
--    λ> numerosConDigitosPrimos4 !! (10^7)
--    322732232572
--    (1.84 secs, 2,000,606,640 bytes)

El código se encuentra en GitHub.

La elaboración de las soluciones se describe en el siguiente vídeo

Alfabeto comenzando en un carácter

Definir la función

   alfabetoDesde :: Char -> String

tal que (alfabetoDesde c) es el alfabeto, en minúscula, comenzando en el carácter c, si c es una letra minúscula y comenzando en ‘a’, en caso contrario. Por ejemplo,

   alfabetoDesde 'e'  ==  "efghijklmnopqrstuvwxyzabcd"
   alfabetoDesde 'a'  ==  "abcdefghijklmnopqrstuvwxyz"
   alfabetoDesde '7'  ==  "abcdefghijklmnopqrstuvwxyz"
   alfabetoDesde '{'  ==  "abcdefghijklmnopqrstuvwxyz"
   alfabetoDesde 'B'  ==  "abcdefghijklmnopqrstuvwxyz"

Soluciones

import Data.Char (isLower, isAscii)
import Test.QuickCheck
 
-- 1ª solución
alfabetoDesde1 :: Char -> String
alfabetoDesde1 c =
  dropWhile (<c) ['a'..'z'] ++ takeWhile (<c) ['a'..'z']
 
-- 2ª solución
alfabetoDesde2 :: Char -> String
alfabetoDesde2 c = ys ++ xs
  where (xs,ys) = span (<c) ['a'..'z']
 
-- 3ª solución
alfabetoDesde3 :: Char -> String
alfabetoDesde3 c = ys ++ xs
  where (xs,ys) = break (==c) ['a'..'z']
 
-- 4ª solución
alfabetoDesde4 :: Char -> String
alfabetoDesde4 c
  | 'a' <= c && c <= 'z' = [c..'z'] ++ ['a'..pred c]
  | otherwise            = ['a'..'z']
 
-- 5ª solución
alfabetoDesde5 :: Char -> String
alfabetoDesde5 c
  | isLower c = [c..'z'] ++ ['a'..pred c]
  | otherwise = ['a'..'z']
 
-- Comprobación de equivalencia
-- ============================
 
-- La propiedad es
prop_alfabetoDesde :: Property
prop_alfabetoDesde =
  forAll (arbitrary `suchThat` isAscii) $ \c ->
  all (== alfabetoDesde1 c)
      [f c | f <- [alfabetoDesde2,
                   alfabetoDesde3,
                   alfabetoDesde4,
                   alfabetoDesde5]]
 
 
-- La comprobación es
--    λ> quickCheck prop_alfabetoDesde
--    +++ OK, passed 100 tests.

El código se encuentra en GitHub.

La elaboración de las soluciones se muestra en el siguiente vídeo

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

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)

El código se encuentra en GitHub.