![Informática de 1º de Matemáticas [Curso 2021-22, Grupo 2]](/WIKIS/I1M2021G2/resources/assets/logoUS.png)
Relación 10
De Informática de 1º de Matemáticas [Curso 2021-22, Grupo 2]
Revisión del 02:07 2 ene 2022 de 148.56.184.10 (discusión)
-- 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)))]
-- Adolfo Sagrera Vivancos
sumaDominoPrimos' :: Integer -> Integer
sumaDominoPrimos' n = sum [a+b | (a,b) <- zip 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]
-- ---------------------------------------------------------------------
-- Elsa Domínguez
sucSumaDominoPrimos :: [Integer]
sucSumaDominoPrimos = [sumaDominoPrimos n | n <- [4..], isPrime n]
--José Manuel García
sucSumaDominoPrimos1 :: [Integer]
sucSumaDominoPrimos1 = [sumaDominoPrimos1 x| x <- drop 2 primes]
-- Adolfo Sagrera Vivancos
sucSumaDominoPrimos' :: [Integer]
sucSumaDominoPrimos' = tail [sumaDominoPrimos p | p <- (tail 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, Adolfo Sagrera Vivancos
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, Adolfo Sagrera Vivancos
sumSumaPrimos :: Int -> Integer
sumSumaPrimos n = fromIntegral (n + sum (take n primes))
--José Manuel García
sumSumaPrimos :: Int -> Integer
sumSumaPrimos n = read (show $ sum $ n : take n primes) :: Integer
-- ---------------------------------------------------------------------
-- 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 , Adolfo Sagrera Vivancos, José Manuel García
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, Adolfo Sagrera Vivancos
esSemiprimo :: Integer -> Bool
esSemiprimo n = or [a*b == n | a <- primeFactors n, b <- primeFactors n]
semiprimos :: [Integer]
semiprimos = filter esSemiprimo [4..]
--José Manuel García
esSemiprimo1 :: Integer -> Bool
esSemiprimo1 n = length (primeFactors n) == 2
semiprimos1 :: [Integer]
semiprimos1 = [x | x<- [1..], esSemiprimo1 x]
-- --------------------------------------------------------------------
-- 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
-- Adolfo Sagrera Vivancos
esBlum1 :: Integer -> Bool
esBlum1 n = or [n == p*q | p <- primeFactors n, q <- primeFactors n, p/=q, mod p 4 ==3, mod q 4 == 3]
sucBlum1 :: [Integer]
sucBlum1 = [ x | x <- [1..], esBlum x]
-- --------------------------------------------------------------------
-- 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, José Manuel García
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..]
-- Adolfo Sagrera Vivancos
esBrillante1 :: Integer -> Bool
esBrillante1 n = or [ n == p*q | p <- primeFactors n, q <- primeFactors n, digitos p == digitos q]
digitos n = length [ read [c]::Int | c <- show n ]
sucBrillante1 :: [Integer]
sucBrillante1 = filter esBrillante [1..]
-- --------------------------------------------------------------------
-- 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]
--José Manuel García, Adolfo Sagrera Vivancos
sucesionesConSuma1 :: Integer -> [(Integer,Integer)]
sucesionesConSuma1 n = [(a,b) | a <- [1..(div n 2)], b <- [a..(n-a)], sum [a..b] == n, n>0]
-- --------------------------------------------------------------------
-- 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, José Manuel García, Adolfo Sagrera Vivancos
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, Adolfo Sagrera Vivancos
propNoAmable :: Integer -> Bool
propNoAmable n = noAmable (abs n+1) == esPotenciaDeDos (abs n+1)
esPotenciaDeDos n = elem n [2^i | i <- [0..20]]
--José Manuel García
propNoAmable1 :: Integer -> Bool
propNoAmable1 1 = True -- Porque 1 == 2^0
propNoAmable1 n = noAmable n' == (2 == last (primeFactors n'))
where n' | n < -1 = abs n
| n == -1 = 2
| n == 0 = 2
| otherwise = n
-- --------------------------------------------------------------------
-- 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, Adolfo Sagrera Vivancos
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]
--José Manuel García
calculoMAF :: Integer -> Float
calculoMAF n = ( fromIntegral $ sum (primeFactors n) :: Float) / (read $ show $ length (primeFactors n) :: Float)
esAritmetico1 :: Integer -> Bool
esAritmetico1 n = (show (round $ calculoMAF n)) ++ ".0" == (show $ calculoMAF n)
-- --------------------------------------------------------------------
-- Ejercicio 7.2. Comprobar con QuickCheck que todos los primos excepto
-- el 2 son aritméticos.
-- ---------------------------------------------------------------------
-- Elsa Domínguez, Adolfo Sagrera Vivancos
primosAritmeticos :: Int -> Bool
primosAritmeticos n = all esAritmetico (take n (tail primes))
--José Manuel García
primosAritmeticos1 :: Int -> Bool
primosAritmeticos1 n = if (isPrime n) && (n/= 2) then (esAritmetico1 (read (show n) :: Integer)) else True
-- 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, Adolfo Sagrera Vivancos
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, Adolfo Sagrera Vivancos
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, Adolfo Sagrera Vivancos
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
-- Adolfo Sagrera Vivancos
esConcatConsecutivos1 :: Integer -> Bool
esConcatConsecutivos1 n = n == ((x*10^k)+x+1)
where x = div n (10^k)
k = div (digitos' n) 2
digitos' n = length [read [c] :: Integer | c <- show n]
-- esProdprimosConsecutivos
-- =========================
esProdprimosConsecutivos :: Integer -> Bool
esProdprimosConsecutivos n = elem n (takeWhile (<=n) prodprimosConsecutivos)
prodprimosConsecutivos = map f (listaDeLongitud 2 primes)
where f [a,b] = a*b
-- Adolfo Sagrera Vivancos
esProdprimosConsecutivos1 :: Integer -> Bool
esProdprimosConsecutivos1 n = n == head (dropWhile (<n) sucProductoPrimos)
sucProductoPrimos1 = [a*b | (a,b) <- zip primes (tail primes)]
-- especiales
-- ==========
especiales :: [Integer]
especiales = [n | n <- prodprimosConsecutivos, esConcatConsecutivos n]
-- Adolfo Sagrera Vivancos
especiales1 :: [Integer]
especiales1 = [ x | x <- sucProductoPrimos, esConcatConsecutivos x]
-- Primer número especial:
-- head especiales
-- 2021