Edición de «Relación 10»

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

-- Elsa Domínguez 
sumaDominoPrimos :: Integer -> Integer
sumaDominoPrimos n = sum $ map f (zip (primosHasta n) (tail (primosHasta n)))
                   where f (a,b) = a+b
                         
primosHasta n = takeWhile (<n) primes 

--José Manuel García
listaPrimosN :: Integer -> [Integer] -- Para obtener la lista de los números primos menores que n.
listaPrimosN n = [p | p <- (take (fromInteger n :: Int) (primes)), p < n]

sumaDominoPrimos1 :: Integer -> Integer
sumaDominoPrimos1 n =  sum [a+b | (a,b) <- (zip (listaPrimosN n) (tail (listaPrimosN n)))]

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

-- Elsa Domínguez 
sucSumaDominoPrimos :: [Integer]
sucSumaDominoPrimos = [sumaDominoPrimos n | n <- [3..], isPrime n]

--José Manuel García
sucSumaDominoPrimos1 :: [Integer]
sucSumaDominoPrimos1 = [sumaDominoPrimos1 x| x <- drop 2 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
-- ---------------------------------------------------------------------

-- Elsa Domínguez
esSumaDominoPrimos :: Integer -> Bool
esSumaDominoPrimos n = elem n (takeWhile (<=n) sucSumaDominoPrimos)

--José Manuel García
esSumaDominoPrimos1 :: Integer -> Bool
esSumaDominoPrimos1 n = head (dropWhile (<n) sucSumaDominoPrimos1) == n

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

-- Elsa Domínguez
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
-- ---------------------------------------------------------------------

-- Elsa Domínguez 
esSumSumaPrimos :: Integer -> Bool
esSumSumaPrimos n = n == head (dropWhile (<n) sucSumSumaPrimos) 

sucSumSumaPrimos = map sumSumaPrimos [1..]


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

-- Elsa Domínguez 
esSemiprimo :: Integer -> Bool
esSemiprimo n = or [a*b == n | a <- primeFactors n, b <- primeFactors n]

semiprimos :: [Integer]
semiprimos = filter esSemiprimo [4..]

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

-- Elsa Domínguez
esBlum :: Integer -> Bool
esBlum n = and [esSemiprimo n, p /= q, rem p 4 == 3, rem q 4 == 3]
         where p = head (primeFactors n) 
               q = last (primeFactors n)
              
sucBlum :: [Integer]
sucBlum = 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
-- ---------------------------------------------------------------------

-- Elsa Domínguez
esBrillante :: Integer -> Bool
esBrillante n = esSemiprimo n && length (show p) == length (show q)
              where p = head (primeFactors n)
                    q = last (primeFactors n)
                      
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
-- ---------------------------------------------------------------------

-- Elsa Domínguez
sucesionesConSuma :: Integer -> [(Integer,Integer)]
sucesionesConSuma n = [(a,b) | a <- [1..div n 2], b <- [a..n-a], (a+b)*(fromIntegral $ length [a..b]) == 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]
-- ---------------------------------------------------------------------

-- Elsa Domínguez
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.
-- ---------------------------------------------------------------------

-- Elsa Domínguez
propNoAmable :: Integer -> Bool
propNoAmable n = noAmable (abs n+1) == esPotenciaDeDos (abs n+1)

esPotenciaDeDos n = elem n [2^i | i <- [0..20]]

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

-- Elsa Domínguez
esAritmetico :: Integer -> Bool
esAritmetico n = rem (sum (divisores n)) (fromIntegral $ (length (divisores n))) == 0

divisores n = [x | x <- [1..div n 2], rem n x == 0] ++ [n]

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

-- Elsa Domínguez
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]
-- ---------------------------------------------------------------------

-- Elsa Domínguez
sucAritmeticosConsecutivos :: Int -> [Integer]
sucAritmeticosConsecutivos n = head (filter consecutivos (listaDeLongitud n sucAritmeticos))

sucAritmeticos = filter esAritmetico [1..]
consecutivos xs = xs == [minimum xs..maximum xs]
listaDeLongitud n xs = map (take n) (tails xs)

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

-- Elsa Domínguez
masInvPalindromo :: Integer -> Bool
masInvPalindromo n = palindromo (n + inverso n)

inverso n = read (reverse (show n)) :: Integer
palindromo n = n == inverso n

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

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

-- Elsa Domínguez
propInvPalindromo :: Integer -> Bool
propInvPalindromo n = not (prodInvPalindromo (abs n)) || masInvPalindromo (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
-- ---------------------------------------------------------------------

-- Elsa Domínguez 
-- esConcatConsecutivos
-- ====================

esConcatConsecutivos :: Integer -> Bool
esConcatConsecutivos n = elem n (takeWhile (<=n) concatEnterosConsecutivos)

concatEnterosConsecutivos = map f (listaDeLongitud 2 [0..])
                          where f [a,b] = read (show a ++ show b) :: Integer

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

esProdprimosConsecutivos :: Integer -> Bool
esProdprimosConsecutivos n = elem n (takeWhile (<=n) prodprimosConsecutivos)

prodprimosConsecutivos = map f (listaDeLongitud 2 primes)
                       where f [a,b] = a*b

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

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

-- Primer número especial:
-- head especiales
-- 2021

</source>