Menu Close

Categoría: Medio

Buenos primos

La sucesión de los números primos es

   2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, ...

Las parejas de primos equidistantes de 5 en dicha sucesión son (3, 7) y (2, 11). Se observa que el cuadrado de 5 es mayor que el producto de los elementos de dichas parejas; es decir,

   5^2 = 25 > 21 = 3 x 7
   5^2 = 25 > 22 = 2 x 11

En cambio, el 7 tiene una pareja de primos equidistantes (la (5, 11)) cuyo producto es mayor que el cuadrado de 7.

   7^2 = 49 < 55 = 5 x 11

Un buen primo es un número primo cuyo cuadrado es mayor que el producto de dos primos cualesquiera equidistantes de él en la sucesión de primos. Por ejemplo, 5 es un buen primo pero 7 no lo es.

Definir las funciones

   esBuenPrimo  :: Integer -> Bool
   buenosPrimos :: [Integer]

tales que

  • (esBuenPrimo n) se verifica si n es un buen primo. Por ejemplo,
     esBuenPrimo 5        ==  True
     esBuenPrimo 7        ==  False
     esBuenPrimo 8746811  ==  True
  • buenosPrimos es la lista de los buenos primos. Por ejemplo,
     λ> take 12 buenosPrimos
     [2,5,11,17,29,37,41,53,59,67,71,97]

Comprobar con QuickCheck que la lista de los buenos primos es infinita; es decir, para cualquier entero positivo n existe un número mayor que n que es un buen primo.

Soluciones

import Data.Numbers.Primes (primes)
import Test.QuickCheck (Property, (==>), quickCheck)
 
esBuenPrimo :: Integer -> Bool
esBuenPrimo n =
  n == y && and [n^2 > x * y | (x, y) <- zip (reverse xs) ys]
  where (xs,y:ys) = span (< n) primes
 
buenosPrimos :: [Integer]
buenosPrimos = filter esBuenPrimo [2..]
 
-- La propiedad es
prop_buenosPrimos :: Integer -> Property
prop_buenosPrimos n =
  n > 0 ==> any esBuenPrimo [n+1..]
 
-- La comprobación es
--    λ> quickCheck prop_buenosPrimos
--    +++ OK, passed 100 tests.

Números compuestos persistentes

Un número compuesto persistente es un número compuesto que no se puede transformar en un número primo cambiando sólo uno de sus dígitos. Por ejemplo,

  • 20 no es un compuesto persistente porque cambiando su último dígito por un 3 se transforma en 23 que es primo.
  • 25 no es un compuesto persistente porque cambiando su primer dígito por un 0 se transforma en 5 que es primo.
  • 200 es un compuesto persistente ya que al cambiar su útimo dígito por un impar se obtienen los números 201, 203, 207, 205 y 209 que no son primos y todos sus demás transformados son pares y, por tanto, tampoco son primos.

Definir las funciones

   esCompuestoPersistente :: Integer -> Bool
   compuestosPersistentes :: [Integer]

tales que

  • (esCompuestoPersistente n) se verifica si n es un número compuesto persistente. Por ejemplo,
     esCompuestoPersistente 20    ==  False
     esCompuestoPersistente 200   ==  True
     esCompuestoPersistente 2021  ==  False
  • compuestosPersistentes es la lista de los números compuestos persistentes. Por ejemplo,
     λ> take 10 compuestoPersistentes
     [200,204,206,208,320,322,324,325,326,328]

Comprobar con QuickCheck que todos los números de la forma 510+2310*k son números compuestos persistentes.

Soluciones

import Data.Numbers.Primes (isPrime, primes)
import Test.QuickCheck (Property, (==>), quickCheck)
 
-- 1ª solución
-- ===========
 
esCompuestoPersistente :: Integer -> Bool
esCompuestoPersistente n =
  esCompuesto n && all (not . isPrime) (transformados n)
 
-- (eCompuesto n) se verifica si n es un número compuesto. Por ejemplo,
--    esCompuesto 15  ==  True
--    esCompuesto 16  ==  True
--    esCompuesto 17  ==  False
esCompuesto :: Integer -> Bool
esCompuesto n =  n > 1 && not (isPrime n)
 
-- (transformados n) es la lista delos números obtenidos modificando uno
-- de los dígitos de n. Por ejemplo,
--    λ> transformados 27
--    [7,17,37,47,57,67,77,87,97,20,21,22,23,24,25,26,28,29]
transformados :: Integer -> [Integer]
transformados n = map read (aux (show n))
  where aux []     = []
        aux [x]    = [[y] | y <- ['0'..'9'], y /= x]
        aux (x:xs) = [y:xs | y <- ['0'..'9'], y /= x] ++
                     [x:ys | ys <- aux xs]
 
compuestosPersistentes :: [Integer]
compuestosPersistentes = filter esCompuestoPersistente [1..]
 
-- 2ª solución
-- ===========
 
esCompuestoPersistente2 :: Integer -> Bool
esCompuestoPersistente2 n =
  not (any (esTransformadoDe n) (takeWhile (<=10^m-1) primes))
  where m = length (show n)
 
-- (esTransformadoDe m n) se verifica si n se puede obtener modificando uno
-- de los dígitos de n. Por ejemplo,
--    esTransformadoDe 27 47  ==  True
--    esTransformadoDe 27 25  ==  True
--    esTransformadoDe 27 45  ==  False
--    esTransformadoDe 27 7   ==  True
--    esTransformadoDe 27 2   ==  False
esTransformadoDe :: Integer -> Integer -> Bool
esTransformadoDe m n =
  1 == length (filter (==False) (zipWith (==) xs zs))
  where xs = show m
        ys = show n
        zs = replicate (length xs - length ys) '0' ++ ys
 
compuestosPersistentes2 :: [Integer]
compuestosPersistentes2 = filter esCompuestoPersistente2 [1..]
 
-- 3ª solución
-- ===========
 
esCompuestoPersistente3 :: Integer -> Bool
esCompuestoPersistente3 n =
  null (primosTransformados n)
 
-- (primosTransformados n) es la lista de los números primos que se
-- puede obtener modificando uno de los dígitos de n. Por ejemplo,
--    primosTransformados 27   ==  [17,23,29,37,47,67,97,7]
--    primosTransformados 26   ==  [23,29]
--    primosTransformados 200  ==  []
--    primosTransformados 202  ==  [2]
primosTransformados :: Integer -> [Integer]
primosTransformados n =
  [x | x <- primosNdigitos p, difierenEnUnaPosicion n x] ++
  [x | x <- [read ('0' : tail ns)], isPrime x]
  where ns = show n
        p  = length ns
 
-- (difierenEnUnaPosicion m n) se verifica si los números m y n difieren
-- en una posición (suponiendo que m y n tienen el mismo número de
-- dígitos). Por ejemplo,
--    difierenEnUnaPosicion 325 375  ==  True
--    difierenEnUnaPosicion 325 357  ==  False
difierenEnUnaPosicion :: Integer -> Integer -> Bool
difierenEnUnaPosicion m n =
  1 == length (filter (==False) (zipWith (==) (show m) (show n)))
 
-- (primosNdigitos n) es la lista de los primos con n dígitos. Por
-- ejemplo,
--    λ> primosNdigitos 2
--    [11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97]
primosNdigitos :: Int -> [Integer]
primosNdigitos n = takeWhile (<=10^n-1) (dropWhile (<=10^(n-1)) primes)
 
compuestosPersistentes3 :: [Integer]
compuestosPersistentes3 = filter esCompuestoPersistente3 [1..]
 
-- 4ª solución
-- ===========
 
esCompuestoPersistente4 :: Integer -> Bool
esCompuestoPersistente4 n =
  null (primosTransformados2 n)
 
-- (primosTransformados2 n) es la lista de los números primos que se
-- puede obtener modificando uno de los dígitos de n. Por ejemplo,
--    primosTransformados2 27   ==  [17,23,29,37,47,67,97,7]
--    primosTransformados2 26   ==  [23,29]
--    primosTransformados2 200  ==  []
--    primosTransformados2 202  ==  [2]
primosTransformados2 :: Integer -> [Integer]
primosTransformados2 n =
  [x | x <- primosEntre (menorTransformado n) (mayorTransformado n)
     , difierenEnUnaPosicion n x] ++
  [x | x <- [read ('0' : tail ns)], isPrime x]
  where ns = show n
        p  = length ns
 
-- (primosEntre x y) lista de números prios mayores o iguales que x y
-- menores o iguales que y. Por ejemplo,
--    primosEntre 11 41  ==  [11,13,17,19,23,29,31,37,41]
primosEntre ::Integer -> Integer -> [Integer]
primosEntre x y = takeWhile (<= y) (dropWhile (< x) primes)
 
-- (menorTransformado x) es el menor número, con la misma cantidad de
-- dígitos que x, que se puede obtener modificando uno de los dígitos de
-- n. Por ejemplo,
--    menorTransformado 375   ==  175
--    menorTransformado 14    ==  11
--    menorTransformado 4     ==  1
--    menorTransformado 1145  ==  1115
menorTransformado :: Integer -> Integer
menorTransformado x
  | x <= 9    = 1
  | y > '1'   = read ('1' : ys)
  | otherwise = read ('1' : show (menorTransformado (read ys)))
  where (y:ys) = show x
 
-- (mayorTransformado x) es el mayor número, con la misma cantidad de
-- dígitos que x, que se puede obtener modificando uno de los dígitos de
-- n. Por ejemplo,
--    mayorTransformado 375   ==  975
--    mayorTransformado 93    ==  99
--    mayorTransformado 4     ==  9
--    mayorTransformado 9945  ==  9995
mayorTransformado :: Integer -> Integer
mayorTransformado x
  | x <= 9    = 9
  | y < '9'   = read ('9' : ys)
  | otherwise = read ('9' : show (mayorTransformado (read ys)))
  where (y:ys) = show x
 
compuestosPersistentes4 :: [Integer]
compuestosPersistentes4 = filter esCompuestoPersistente4 [1..]
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> compuestosPersistentes !! 1000
--    8180
--    (0.54 secs, 1,577,628,232 bytes)
--    λ> compuestosPersistentes2 !! 1000
--    8180
--    (10.13 secs, 15,883,929,392 bytes)
--    λ> compuestosPersistentes3 !! 1000
--    8180
--    (7.09 secs, 14,165,470,304 bytes)
--    λ> compuestosPersistentes4 !! 1000
--    8180
--    (6.54 secs, 13,332,608,480 bytes)
 
-- Propiedad
-- =========
 
-- La propiedad es
prop_compuestosPersistentes :: Integer -> Property
prop_compuestosPersistentes k =
  k > 0 ==> esCompuestoPersistente (510 + 2310 * k)
 
-- La comprobación de la propiedad es
--    λ> quickCheck prop_compuestosPersistentes
--    +++ OK, passed 100 tests.

Números bigenerados

Se dice que y es un generador de x si x es igual a la suma de y los dígitos de y. Por ejemplo, 1996 y 2014 son generadores de 2021 ya que

   2021 = 1996 + 1 + 9 + 9 + 6
   2021 = 2014 + 2 + 0 + 1 + 4

Un número bigenerado es un número que tiene exactamente 2 generadores. Por ejemplo,

  • 2021 es un número bigenerados y sus generadores son 1996 y 2014
  • 20 no es bigenerador porque no tiene ningún generador
  • 21 no es bigenerador porque tiene sólo un generador (el 15).
  • 101 es el menor número bigenerado ysus generadores son 91 y 100.

Definir las funciones

   esBigenerado :: Integer -> Bool
   bigenerados  :: [Integer]

tales que

  • (esBigenerado x) se verifica si x es bigenerado. Por ejemplo,
     esBigenerado 2021  ==  True
     esBigenerado 20    ==  False
     esBigenerado 21    ==  False
     esBigenerado 101   ==  True
  • bigenerados es la lista de los números bigenerados. Por ejemplo,
     λ> take 12 bigenerados
     [101,103,105,107,109,111,113,115,117,202,204,206]

Comprobar con QuickCheck que la lista de los números bigenerados es infinita; es decir, para cualquier número positivo n existe un y mayor que x que es bigenerado.

Soluciones

import Test.QuickCheck (Property, (==>), quickCheck)
 
esBigenerado :: Integer -> Bool
esBigenerado x = length (generadores x) == 2
 
-- (generadores x) es la lista de los generadores de x. Por ejemplo,
--    generadores 2021  ==  [1996,2014]
--    generadores 20    ==  []
--    generadores 21    ==  [15]
--    generadores 101   ==  [91,100]
generadores :: Integer -> [Integer]
generadores x = filter (esGenerador x) [1..x]
 
-- (esGenerador x y) se verifica si y es un generador de x. Por ejemplo,
--    esGenerador 818 796  ==  True
--    esGenerador 818 805  ==  True
esGenerador :: Integer -> Integer -> Bool
esGenerador x y = x == y + sumaDigitos y
 
-- (sumaDigitos n) es la suma de los dígitos de n. Por ejemplo,
--    sumaDigitos 2021  ==  5
sumaDigitos :: Integer -> Integer
sumaDigitos = sum . digitos
 
-- (digitos n) es la lista de los dígitos de n. Por ejemplo,
--    digitos 2021  ==  [2,0,2,1]
digitos :: Integer -> [Integer]
digitos x = [read [c] | c <- show x]
 
bigenerados :: [Integer]
bigenerados = filter esBigenerado [1..]
 
-- La propiedad es
prop_bigenerados :: Integer -> Property
prop_bigenerados n =
  n >= 0 ==> any esBigenerado [n+1..]
 
-- La comprobación es
--    λ> quickCheck prop_bigenerados
--    +++ OK, passed 100 tests.

Nuevas soluciones

  • En los comentarios se pueden escribir nuevas soluciones.
  • El código se debe escribir entre una línea con <pre lang="haskell"> y otra con </pre>

Caminos reducidos

Un camino es una sucesión de pasos en una de las cuatros direcciones Norte, Sur, Este, Oeste. Ir en una dirección y a continuación en la opuesta es un esfuerzo que se puede reducir, Por ejemplo, el camino [Norte,Sur,Este,Sur] se puede reducir a [Este,Sur].

Un camino se dice que es reducido si no tiene dos pasos consecutivos en direcciones opuesta. Por ejemplo, [Este,Sur] es reducido y [Norte,Sur,Este,Sur] no lo es.

En Haskell, las direcciones y los caminos se pueden definir por

   data Direccion = N | S | E | O deriving (Show, Eq)
   type Camino = [Direccion]

Definir la función

   reducido :: Camino -> Camino

tal que (reducido ds) es el camino reducido equivalente al camino ds. Por ejemplo,

   reducido []                              ==  []
   reducido [N]                             ==  [N]
   reducido [N,O]                           ==  [N,O]
   reducido [N,O,E]                         ==  [N]
   reducido [N,O,E,S]                       ==  [] 
   reducido [N,O,S,E]                       ==  [N,O,S,E]
   reducido [S,S,S,N,N,N]                   ==  []
   reducido [N,S,S,E,O,N]                   ==  []
   reducido [N,S,S,E,O,N,O]                 ==  [O]
   reducido (take (10^7) (cycle [N,E,O,S])) ==  []

Nótese que en el penúltimo ejemplo las reducciones son

       [N,S,S,E,O,N,O]  
   --> [S,E,O,N,O]  
   --> [S,N,O]  
   --> [O]

Soluciones

data Direccion = N | S | E | O deriving (Show, Eq)
 
type Camino = [Direccion]
 
-- 1ª solución (por recursión):
reducido1 :: Camino -> Camino
reducido1 [] = []
reducido1 (d:ds) | null ds'                = [d]
                 | d == opuesta (head ds') = tail ds'
                 | otherwise               = d:ds'
    where ds' = reducido1 ds
 
opuesta :: Direccion -> Direccion
opuesta N = S
opuesta S = N
opuesta E = O
opuesta O = E
 
-- 2ª solución (por plegado)
reducido2 :: Camino -> Camino
reducido2 = foldr aux []
    where aux N (S:xs) = xs
          aux S (N:xs) = xs
          aux E (O:xs) = xs
          aux O (E:xs) = xs
          aux x xs     = x:xs
 
-- 3ª solución 
reducido3 :: Camino -> Camino
reducido3 []       = []
reducido3 (N:S:ds) = reducido3 ds
reducido3 (S:N:ds) = reducido3 ds
reducido3 (E:O:ds) = reducido3 ds
reducido3 (O:E:ds) = reducido3 ds
reducido3 (d:ds) | null ds'                = [d]
                 | d == opuesta (head ds') = tail ds'
                 | otherwise               = d:ds'
    where ds' = reducido3 ds
 
-- 4ª solución
reducido4 :: Camino -> Camino
reducido4 ds = reverse (aux ([],ds)) where 
    aux (N:xs, S:ys) = aux (xs,ys)
    aux (S:xs, N:ys) = aux (xs,ys)
    aux (E:xs, O:ys) = aux (xs,ys)
    aux (O:xs, E:ys) = aux (xs,ys)
    aux (  xs, y:ys) = aux (y:xs,ys)
    aux (  xs,   []) = xs
 
-- Comparación de eficiencia
--    ghci> reducido1 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (3.87 secs, 460160736 bytes)
--    ghci> reducido2 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (1.16 secs, 216582880 bytes)
--    ghci> reducido3 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (0.58 secs, 98561872 bytes)
--    ghci> reducido4 (take (10^6) (cycle [N,E,O,S]))
--    []
--    (0.64 secs, 176154640 bytes)
--    
--    ghci> reducido3 (take (10^7) (cycle [N,E,O,S]))
--    []
--    (5.43 secs, 962694784 bytes)
--    ghci> reducido4 (take (10^7) (cycle [N,E,O,S]))
--    []
--    (9.29 secs, 1722601528 bytes)
-- 
--    ghci> length $ reducido3 (take 2000000 $ cycle [N,O,N,S,E,N,S,O,S,S])
--    400002
--    (4.52 secs, 547004960 bytes)
--    ghci> length $ reducido4 (take 2000000 $ cycle [N,O,N,S,E,N,S,O,S,S])
--    400002
--    
--    ghci> let n=10^6 in reducido1 (replicate n N ++ replicate n S)
--    []
--    (7.35 secs, 537797096 bytes)
--    ghci> let n=10^6 in reducido2 (replicate n N ++ replicate n S)
--    []
--    (2.30 secs, 244553404 bytes)
--    ghci> let n=10^6 in reducido3 (replicate n N ++ replicate n S)
--    []
--    (8.08 secs, 545043608 bytes)
--    ghci> let n=10^6 in reducido4 (replicate n N ++ replicate n S)
--    []
--    (1.96 secs, 205552240 bytes)

La sucesión ECG

La sucesión ECG estás definida por a(1) = 1, a(2) = 2 y, para n >= 3, a(n) es el menor natural que aún no está en la sucesión tal que a(n) tiene algún divisor común con a(n-1).

Los primeros términos de la sucesión son 1, 2, 4, 6, 3, 9, 12, 8, 10, 5, 15, …

Al dibujar su gráfica, se parece a la de los electrocardiogramas (abreviadamente, ECG). Por ello, la sucesión se conoce como la sucesión ECG.

Definir las funciones

   sucECG :: [Integer]
   graficaSucECG :: Int -> IO ()

tales que

  • sucECG es la lista de los términos de la sucesión ECG. Por ejemplo,
     λ> take 20 sucECG
     [1,2,4,6,3,9,12,8,10,5,15,18,14,7,21,24,16,20,22,11]
     λ> sucECG !! 6000
     6237
  • (graficaSucECG n) dibuja la gráfica de los n primeros términos de la sucesión ECG. Por ejemplo, (graficaSucECG 160) dibuja

Soluciones

import Data.List (delete)
import Graphics.Gnuplot.Simple
 
sucECG :: [Integer]
sucECG = 1 : ecg 2 [2..]
  where ecg x zs = f zs
          where f (y:ys) | gcd x y > 1 = y : ecg y (delete y zs)
                         | otherwise   = f ys
 
graficaSucECG :: Int -> IO ()
graficaSucECG n =
  plotList [ Key Nothing
           , PNG "La_sucesion_ECG.png" 
           ]
           (take n sucECG)