Ver el código de «Relación 10 Sol»

<source lang='haskell'>
-- I1M 2021-22: Relación 10
-- Propiedades del número 2021.
-- Departamento de Ciencias de la Computación e I.A.
-- Universidad de Sevilla
-- =====================================================================

-- ---------------------------------------------------------------------
-- Introducción                                                       --
-- ---------------------------------------------------------------------

-- En esta relación se presentan ejercicios sobre propiedades del número
-- 2021.

-- ---------------------------------------------------------------------
-- § Librerías auxiliares                                             --
-- ---------------------------------------------------------------------

import Data.Numbers.Primes
import Data.List
import Test.QuickCheck

-- ---------------------------------------------------------------------
-- Ejercicio 1.1. Consideramos todos los primos menores que 100:
--    2, 3, 5, 7, 11, ..., 89, 97
-- y formamos los correspondientes pares de dominó:
--    (2,3), (3,5), (5,7), ..., (83,89), (89,97).
-- La suma de los números en todos los pares es 2021.
--
-- Definir la función
--    sumaDominoPrimos :: Integer -> Integer
-- tal que (sumaDominoPrimos n) es la suma de los números de los pares
-- de dominó formada a partir de los primos menores que n. Por ejemplo,
--    sumaDominoPrimos 100 == 2021
--    sumaDominoPrimos 200 == 8253
-- ---------------------------------------------------------------------

sumaDominoPrimos :: Integer -> Integer
sumaDominoPrimos n = sum (zipWith (+) ps (tail ps))
  where ps = takeWhile (<=n) primes

-- ---------------------------------------------------------------------
-- Ejercicio 1.2. Definir la constante
--   sucSumaDominoPrimos :: [Integer]
-- tal que sucSumaDominoPrimos es la sucesión de los números que son
-- suma de pares de dominó formado con números primos. Por ejemplo,
--   λ> take 25 sucSumaDominoPrimos
--   [5,13,25,43,67,97,133,175,227,287,355,433,517,607,707,819,939,1067,
--    1205,1349,1501,1663,1835,2021,2219]
-- ---------------------------------------------------------------------

sucSumaDominoPrimos :: [Integer]
sucSumaDominoPrimos = tail (map sumaDominoPrimos primes)

-- ---------------------------------------------------------------------
-- Ejercicio 1.3. Definir la sucesión
--   esSumaDominoPrimos :: Integer -> Bool
-- tal que (esSumaDominoPrimos n) se verifica si n es un número de la
-- sucesión anterior. Por ejemplo,
--  esSumaDominoPrimos 2021    == True
--  esSumaDominoPrimos 1234509 == False
-- ---------------------------------------------------------------------

esSumaDominoPrimos :: Integer -> Bool
esSumaDominoPrimos n = n == head (dropWhile (<n) sucSumaDominoPrimos)

-- ---------------------------------------------------------------------
-- Ejercicio 2.1. El número 2021 es la suma de 33 más la suma de los 33
-- primeros números primos.
--
-- Definir la función
--   sumSumaPrimos :: Int -> Integer
-- tal que (sumSumaPrimos n) es la suma de n más los n primeros números
-- primos. Por ejemplo,
--   sumSumaPrimos 33 == 2021
--   sumSumaPrimos 52 == 5641
-- ---------------------------------------------------------------------

sumSumaPrimos :: Int -> Integer
sumSumaPrimos n = fromIntegral n + sum (take n primes)

-- ---------------------------------------------------------------------
-- Ejercicio 2.2. Definir la función
--    esSumSumaPrimos :: Integer -> Bool
-- tal que (esSumSumaPrimos n) se verifica si n es de la suma de m más
-- los m primeros primos, para algún entero m. Por ejemplo,
--    esSumSumaPrimos 2021       == True
--    esSumSumaPrimos 120        == False
--    esSumSumaPrimos 1234567893 == False
--    esSumSumaPrimos 774511387  == True
-- ---------------------------------------------------------------------

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

esSumSumaPrimos :: Integer -> Bool
esSumSumaPrimos n = n == head (dropWhile (<n) sucSumSumaPrimos)

-- sucSumSumaPrimos es la lista de los números de la forma m más la suma
-- de los m primeros primos. Por ejemplo,
--    take 18 sucSumSumaPrimos
--    [3,7,13,21,33,47,65,85,109,139,171,209,251,295,343,397,457,519]
sucSumSumaPrimos :: [Integer]
sucSumSumaPrimos = map sumSumaPrimos [1..]

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

esSumSumaPrimos2 :: Integer -> Bool
esSumSumaPrimos2 n = n == head (dropWhile (<n) sucSumSumaPrimos2)

sucSumSumaPrimos2 :: [Integer]
sucSumSumaPrimos2 = zipWith (+) [1..] (scanl1 (+) primes)

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

-- La comparación es
--    λ> esSumSumaPrimos 123456789  == False
--    (11.60 secs, 34,680,466,648 bytes)
--    λ> esSumSumaPrimos2 123456789 == False
--    (0.01 secs, 11,300,288 bytes)
--
--    λ> esSumSumaPrimos 774511387  == True
--    (83.50 secs, 234,694,973,880 bytes)
--    λ> esSumSumaPrimos2 774511387 == True
--    (0.03 secs, 42,326,032 bytes)

-- --------------------------------------------------------------------
-- Ejercicio 3. Un número semiprimo es un número natural que es producto
-- de dos números primos no necesariamente distintos. Por ejemplo, 26 es
-- semiprimo (porque 26 = 2×13) y 49 también lo es (porque 49 = 7×7).
--
-- Definir las funciones
--    esSemiprimo :: Integer -> Bool
--    semiprimos  :: [Integer]
-- tales que
-- + (esSemiprimo n) se verifica si n es semiprimo. Por ejemplo,
--      esSemiprimo 26          ==  True
--      esSemiprimo 49          ==  True
--      esSemiprimo 8           ==  False
--      esSemiprimo 2021        ==  True
--      esSemiprimo (21+10^14)  ==  True
-- + semiprimos es la sucesión de números semiprimos. Por ejemplo,
--      take 10 semiprimos   ==  [4,6,9,10,14,15,21,22,25,26]
--      semiprimos !! 580    ==  2021
--      semiprimos !! 10000  ==  40886
-- ---------------------------------------------------------------------

-- 1ª definición
-- =============

esSemiprimo1 :: Integer -> Bool
esSemiprimo1 n = any prop ps
  where ps = takeWhile (<= (n `div` 2)) primes
        prop q = r == 0 && isPrime d
          where (d,r) = quotRem n q

semiprimos1 :: [Integer]
semiprimos1 = filter esSemiprimo1 [4..]

-- 2ª definición
-- =============

esSemiprimo2 :: Integer -> Bool
esSemiprimo2 n = length (primeFactors n) == 2

semiprimos2 :: [Integer]
semiprimos2 = filter esSemiprimo2 [4..]

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

-- La comparación es
--    λ> semiprimos1 !! 1000  == 3599
--    (0.52 secs, 1,041,413,376 bytes)
--    λ> semiprimos2 !! 1000 == 3599
--    (0.04 secs, 51,977,912 bytes)

-- Por tanto:

esSemiprimo = esSemiprimo2
semiprimos  = semiprimos2

-- --------------------------------------------------------------------
-- Ejercicio 4. Un número natural n es un número entero Blum si
-- n = p × q es un semiprimo para el que p y q son distintos primos
-- congruentes con 3 módulo 4. Es decir, p y q tienen que ser de la
-- forma 4 t + 3, para algún número entero t. Los números enteros de
-- esta forma se denominan números primos de Blum.  Los primeros enteros
-- de Blum son
--    21, 33, 57, 69, 77, 93, 129, 133, 141, 161, 177, ...
--
-- Definir las funciones
--    esBlum :: Integer -> Bool
--    sucBlum  :: [Integer]
-- tales que
-- + (esBlum n) se verifica si n es un número de Blum. Por ejemplo,
--      esBlum 26          ==  False
--      esBlum 49          ==  False
--      esBlum 77          ==  True
--      esBlum 2021        ==  True
--      esBlum (21+10^14)  ==  True
-- + sucBlum es la sucesión de números de Blum. Por ejemplo,
--      take 10 sucBlum  ==  [21,33,57,69,77,93,129,133,141,161]
--      sucBlum !! 132    ==  2021
--      sucBlum !! 10000  ==  186821
-- ---------------------------------------------------------------------

esBlum :: Integer -> Bool
esBlum n = length ps == 2 && p /= q && p `rem` 4 == 3 && q `rem` 4 == 3
  where ps      = primeFactors n
        (p:q:_) = ps

sucBlum  :: [Integer]
sucBlum = filter esBlum [4..]

sucBlum2  :: [Integer]
sucBlum2 = filter esBlum semiprimos

-- --------------------------------------------------------------------
-- Ejercicio 5. Un número semiprimo n = p x q es brillante si p y q
-- tienen el mismo número de dígitos.
--
-- Definir las funciones
--    esBrillante :: Integer -> Bool
--    sucBrillantes  :: [Integer]
-- tales que
-- + (esBrillante n) se verifica si n es brillante. Por ejemplo,
--      esBrillante 26          ==  False
--      esBrillante 49          ==  True
--      esBrillante 77          ==  False
--      esBrillante 2021        ==  True
--      esBrillante (21+10^14)  ==  False
-- + sucBrillantes es la sucesión de números brillantes. Por ejemplo,
--      take 10 sucBrillante   ==  [4,6,9,10,14,15,21,25,35,49]
--      sucBrillante !! 130    ==  2021
--      sucBrillante !! 10000  ==  696649
-- ---------------------------------------------------------------------

esBrillante :: Integer -> Bool
esBrillante n = length ps == 2 && length (show p) == length (show q)
  where ps = primeFactors n
        p = head ps
        q = head (tail ps)

sucBrillante  :: [Integer]
sucBrillante = filter esBrillante [4..]

-- --------------------------------------------------------------------
-- Ejercicio 6.1. Un número natural es amable si se puede expresar como
-- suma de, al menos, dos números naturales consecutivos. Por ejemplo,
-- 2021 es amable pues
--    2021 = 20 + 21 + ... + 65 + 66.
-- La mayoría de los números naturales son amables, por lo que vamos a
-- calcular la lista de los números no amables.
--
-- Los primeros números no amables son
--    1, 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024, 2048, 4096, 8192,
--    16384, 32768, 65536, 131072, 262144
--
-- Definir la función
--   sucesionesConSuma :: Int -> [(Int,Int)]
-- tal que (sucesionesConSuma n) es la lista de los pares formados por
-- el primero y por el último elemento de las sucesiones de números
-- naturales consecutivos con suma n. Por ejemplo,
--    sucesionesConSuma 15             == [(1,5),(4,6),(7,8)]
--    sucesionesConSuma 2021           == [(20,66),(26,68),(1010,1011)]
--    length (sucesionesConSuma 2021)  == 3
--    length (sucesionesConSuma 3000)  == 7
-- ---------------------------------------------------------------------

sucesionesConSuma :: Integer -> [(Integer,Integer)]
sucesionesConSuma n =
    [(x,y) | y <- [1..1 + n `div` 2]
           , x <- [1..y-1]
           , (x+y)*(y-x+1) == 2*n]

-- --------------------------------------------------------------------
-- Ejercicio 6.2. Definir las funciones
--    noAmable :: Integer -> Bool
--    sucNoAmables :: [Integer]
-- tales que
-- + (noAmable n) se verifica si n es un número no amable. Por ejemplo,
--    noAmable 2021 == False
--    noAmable 1024 == True
-- + sucNoAmables es la lista de números naturales no amables. Por
--   ejemplo,
--    take 10 sucNoAmables == [1,2,4,8,16,32,64,128,256,512]
-- ---------------------------------------------------------------------

noAmable :: Integer -> Bool
noAmable n = null (sucesionesConSuma n)

sucNoAmables :: [Integer]
sucNoAmables = filter noAmable [1..]

-- --------------------------------------------------------------------
-- Ejercicio 6.3. Comprobar con QuickCheck que un número natural es no
-- amable si y sólo si es potencia de 2.
-- ---------------------------------------------------------------------

propNoAmable :: Integer -> Bool
propNoAmable n = noAmable m == esPotencia2 m
  where m = 1 + abs n

-- (esPotencia2 n) se verifica si n es potencia de 2. Por ejemplo,
--    esPotencia2 16 == True
--    esPotencia2 18 == False
esPotencia2 :: Integer -> Bool
esPotencia2 0 = False
esPotencia2 1 = True
esPotencia2 n = even n && esPotencia2 (n `div` 2)

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

-- --------------------------------------------------------------------
-- Ejercicio 7.1. Un número natural se denomina aritmético si la media
-- aritmética de sus divisores es un número entero.
--
-- Definir la función
--    esAritmetico :: Integer -> Bool
-- tal que (esAritmetico n) se verifica si n es un número aritmético.
-- Por ejemplo,
--    esAritmetico 2021 == True
--    esAritmetico 24   == False
-- ---------------------------------------------------------------------

esAritmetico :: Integer -> Bool
esAritmetico n = sum ds `mod` genericLength ds == 0
  where ds = divisores n


-- (divisores n) es la lista de los divisores de n. Por ejemplo,
--    divisores 2021 == [2021,1,43,47]
divisores :: Integer -> [Integer]
divisores n = n : [x | x <- [1.. n`div`2], n `rem` x == 0]

-- --------------------------------------------------------------------
-- Ejercicio 7.2. Comprobar con QuickCheck que todos los primos excepto
-- el 2 son aritméticos.
-- ---------------------------------------------------------------------

primosAritmeticos :: Int -> Bool
primosAritmeticos n = all esAritmetico (take n (tail primes))

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

-- --------------------------------------------------------------------
-- Ejercicio 7.3. Definir la función
--    sucAritmeticosConsecutivos :: Int -> [Integer]
-- tal que (sucAritmeticosConsecutivos n) es una sucesión de n números
-- aritméticos consecutivos. Por ejemplo,
--    λ> sucAritmeticosConsecutivos 5
--    [19,20,21,22,23]
--    λ> sucAritmeticosConsecutivos 20
--    [4955,4956,4957,4958,4959,4960,4961,4962,4963,4964,4965,4966,4967,
--     4968,4969,4970,4971,4972,4973,4974]
-- ---------------------------------------------------------------------

sucAritmeticosConsecutivos :: Int -> [Integer]
sucAritmeticosConsecutivos n =
  head (filter consecutivos (segmentosLongitud n sucAritmeticos))

-- sucAritmeticos es la sucesión de los números aritméticos. Por
-- ejemplo,
--    take 10 sucAritmeticos == [1,3,5,6,7,11,13,14,15,17]
sucAritmeticos :: [Integer]
sucAritmeticos = filter esAritmetico [1..]

-- (segmentosLongitud n xs) es la sucesión de los segmentos de xs de
-- longitud n. Por ejemplo,
--    λ> segmentosLongitud 2 "Sevilla"
--    ["Se","ev","vi","il","ll","la","a",""]
--    λ> segmentosLongitud 3 "Sevilla"
--    ["Sev","evi","vil","ill","lla","la","a",""]
segmentosLongitud :: Int -> [a] -> [[a]]
segmentosLongitud n xs = map (take n) (tails xs)

-- (consecutivos ns) se verifica si ns es una lista de números
-- consecutivos. Por ejemplo,
--    consecutivos [4,5,6] == True
--    consecutivos [4,5,7] == False
consecutivos :: [Integer] -> Bool
consecutivos ns = all (==1) (zipWith (-) (tail ns) ns)

-- Otra definición de consecutivos es
consecutivos2 :: [Integer] -> Bool
consecutivos2 ns = ns == [minimum ns .. maximum ns]

-- --------------------------------------------------------------------
-- Ejercicio 8.1. El número 2021 tiene las propiedades siguientes:
-- + sumándole su inverso es un número palíndromo: 2021 + 1202 = 3223
-- + multiplicándolo por su inverso también lo es: 2021 * 1202 = 2429242
--
-- Definir las funciones
--    masInvPalindromo :: Integer -> Bool
--    prodInvPalindromo :: Integer -> Bool
-- tales que
-- + (masInvPalindromo n) se verifica si n más su inverso es
--   palíndromo. Por ejemplo,
--     masInvPalindromo 2021  == True
--      masInvPalindromo 109   == False
-- + (prodInvPalindromo n) se verifica si n por su inverso es
--   palíndromo. Por ejemplo,
--      prodInvPalindromo 2021 == True
--      prodInvPalindromo 1097 == False
-- ---------------------------------------------------------------------

masInvPalindromo :: Integer -> Bool
masInvPalindromo n = palindromo (n + inversoN n)

-- (inversoN x) es el número obtenido invirtiendo los dígitos de x. Por
-- ejemplo,
--    inversoN 2021 == 1202
inversoN :: Integer -> Integer
inversoN = read . reverse . show

-- (palindromo n) se verifica si n es un palíndromo. Por ejemplo,
--    palindromo 23532 == True
--    palindromo 23352 == False
palindromo :: Integer -> Bool
palindromo n = show n == reverse (show n)

prodInvPalindromo :: Integer -> Bool
prodInvPalindromo n = palindromo (n * inversoN n)

-- --------------------------------------------------------------------
-- Ejercicio 8.2.. Comprobar con QuickCheck que todo número
-- prodInvPalindromo es masInvPalindromo.
-- ---------------------------------------------------------------------

propInvPalindromo :: Integer -> Bool
propInvPalindromo n = not (prodInvPalindromo m) || masInvPalindromo m
  where m = 1 + abs n

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

-- --------------------------------------------------------------------
-- Ejercicio 9. Comprobar que el número 2021 es el menor  número
-- natural que verifica las siguientes propiedades:
--  (+) es la concatenación de dos enteros consecutivos (20 y 21)
--  (+) es el producto de dos primos consecutivos (43 y 47)
--
-- Para ello, definir las funciones
--    esConcatConsecutivos :: Integer -> Bool
--    esProdprimosConsecutivos :: Integer -> Bool
--    especiales :: [Integer]
-- tales que
-- + (esConcatConsecutivos n) se verifica si n es la concatenación de
--   dos enteros consecutivos. Por ejemplo,
--      esConcatConsecutivos 2021 == True
-- + (esProdprimosConsecutivos n) se verifica si n es el producto de dos
--   primos consecutivos
--      esProdprimosConsecutivos 2021 == True
-- + espaciales es la lista de números naturales que verifican las dos
--   propiedaes anteriores
--      head especiales == 2021
-- ---------------------------------------------------------------------

-- esConcatConsecutivos
-- ====================

esConcatConsecutivos :: Integer -> Bool
esConcatConsecutivos n =
  n == head (dropWhile (<n) concatEnterosConsecutivos)

-- concatEnterosConsecutivos es la lista de números obtenidos
-- concatenando dos enteros consecutivos. Por ejemplo,
--    λ> take 10 concatEnterosConsecutivos
--    [12,23,34,45,56,67,78,89,910,1011]
concatEnterosConsecutivos :: [Integer]
concatEnterosConsecutivos = zipWith pegaNumeros xs (tail xs)
  where xs = [1..]

-- (pegaNumeros n m) es el número otenido añadiendo los dígitos de m a
-- continuación de los de n. Por ejemplo,
--    pegaNumeros 23 416 == 23416
pegaNumeros :: Integer -> Integer -> Integer
pegaNumeros n m = read (show n ++ show m)

-- esProdprimosConsecutivos
-- =========================

esProdprimosConsecutivos :: Integer -> Bool
esProdprimosConsecutivos n =
  n == head (dropWhile (<n) productoPrimosConsecutivos)

-- productoPrimosConsecutivos es la sucesión de los números que son
-- productos de dos primos consecutivos. Por ejemplo,
--    λ> take 20 productoPrimosConsecutivos
--    [6,15,35,77,143,221,323,437,667,899,1147,1517,1763,2021,2491,3127,
--     3599,4087,4757,5183]
productoPrimosConsecutivos :: [Integer]
productoPrimosConsecutivos =
  zipWith (*) primes (tail primes)

-- especiales
-- ==========

especiales :: [Integer]
especiales = [n | n <- productoPrimosConsecutivos
                , esConcatConsecutivos n]

-- concatPrimos es la lista de números obtenidos concatenando dos primos
-- consecutivos. Por ejemplo,
--    λ> take 20 concatPrimos
--    [23,35,57,711,1113,1317,1719,1923,2329,2931,3137,3741,4143,4347,4753,
--     5359,5961,6167,6771,7173]
concatPrimos :: [Integer]
concatPrimos = zipWith pegaNumeros primes (tail primes)

-- Primer número especial:
--    head especiales == 2021
</source>