Menu Close

Etiqueta: and

Números perfectos y cojonudos

Un número perfecto es un número entero positivo que es igual a la suma de sus divisores propios. Por ejemplo, el 28 es perfecto porque sus divisores propios son 1, 2, 4, 7 y 14 y 1+2+4+7+14 = 28.

Un entero positivo x es un número cojonudo si existe un n tal que n > 0, x = 2^n·(2^(n+1)-1) y 2^(n+1)-1 es primo. Por ejemplo, el 28 es cojonudo ya que para n = 2 se verifica que 2 > 0, 28 = 2^2·(2^3-1) y 2^3-1 = 7 es primo.

Definir la funciones

   esPerfecto                      :: Integer -> Bool
   esCojonudo                      :: Integer -> Bool
   equivalencia_CojonudosPerfectos :: Integer -> Bool

tales que

  • (esPerfecto x) se verifica si x es perfecto. Por ejemplo,
     esPerfecto 28  ==  True
     esPerfecto 30  ==  False
  • (esCojonudo x) se verifica si x es cojonudo. Por ejemplo,
     esCojonudo 28                   ==  True
     esCojonudo 30                   ==  False
     esCojonudo 2305843008139952128  ==  True
  • (equivalenciaCojonudosPerfectos n) se verifica si para todos los números x menores o iguales que n se tiene que x es perfecto si, y sólo si, x es cojonudo. Por ejemplo,
     equivalenciaCojonudosPerfectos 3000  ==  True

Soluciones

import Data.Numbers.Primes
import Data.List
 
-- 1ª definición de esPerfecto
-- ===========================
 
esPerfecto1 :: Integer -> Bool
esPerfecto1 x =
  sum (divisoresPropios1 x) == x
 
divisoresPropios1 :: Integer -> [Integer]
divisoresPropios1 x =
  [y | y <- [1..x-1]
     , x `mod` y == 0]
 
-- 2ª definición de esPerfecto
-- ===========================
 
esPerfecto2 :: Integer -> Bool
esPerfecto2 n = sum (divisoresPropios2 n) == n
 
divisoresPropios2 :: Integer -> [Integer]
divisoresPropios2 n =
  (delete n . nub . map product . subsequences) (primeFactors n)
 
-- Comparación de eficiencia
-- =========================
 
--    λ> esPerfecto1 33550336
--    True
--    (48.70 secs, 6,976,432,536 bytes)
--    λ> esPerfecto2 33550336
--    True
--    (0.01 secs, 0 bytes)
--    
--    λ> [x | x <- [1..10^4], esPerfecto1 x]
--    [6,28,496,8128]
--    (72.88 secs, 10,411,693,760 bytes)
--    λ> [x | x <- [1..10^4], esPerfecto2 x]
--    [6,28,496,8128]
--    (0.69 secs, 311,388,248 bytes)
 
-- 1ª definición de esCojonudo
-- ===========================
 
esCojonudo1 :: Integer -> Bool
esCojonudo1 x = pertenece x cojonudos
 
cojonudos :: [Integer]
cojonudos =
  [2^n*p | n <- [1..]
         , let p = 2^(n+1) - 1
         , isPrime p]
 
pertenece :: Integer -> [Integer] -> Bool
pertenece x ys =
  head (dropWhile (<x) ys) == x
 
-- 2ª definición de esCojonudo
-- ===========================
 
esCojonudo2 :: Integer -> Bool
esCojonudo2 n | length p /= 1  = False
              | otherwise      = head p == 2 * product d -1
    where (d,p) = partition (==2) (primeFactors n)
 
-- Comparación de eficiencia
-- =========================
 
--    λ> length [x | x <- [1..10^5], esCojonudo1 x]
--    4
--    (0.37 secs, 23,492,384 bytes)
--    λ> length [x | x <- [1..10^5], esCojonudo2 x]
--    4
--    (7.46 secs, 4,245,266,408 bytes)
 
-- Comprobación de equivalencia
-- ============================
 
equivalencia_CojonudosPerfectos :: Integer -> Bool
equivalencia_CojonudosPerfectos n =
  and [esCojonudo1 x == esPerfecto2 x | x <- [1..n]]

Conjetura de Rassias

El artículo de esta semana del blog Números y hoja de cálculo está dedicado a la Conjetura de Rassias. Dicha conjetura afirma que

Para cada número primo p > 2 existen dos primos a y b, con a < b, tales que
(p-1)a = b+1

Dado un primo p > 2, los pares de Rassia de p son los pares de primos (a,b), con a < b, tales que (p-1)a = b+1. Por ejemplo, (2,7) y (3,11) son pares de Rassia de 5 ya que

  • 2 y 7 son primos, 2 < 7 y (5-1)·2 = 7+1
  • 3 y 11 son primos, 3 < 11 y (5-1)·3 = 11+1

Definir las siguientes funciones

   paresRassias     :: Integer -> [(Integer,Integer)]
   conjeturaRassias :: Integer -> Bool

tales que

  • (paresRassias p) es la lista de los pares de Rassias del primo p (que se supone que es mayor que 2). Por ejemplo,
     take 3 (paresRassias 5)    == [(2,7),(3,11),(5,19)]
     take 3 (paresRassias 1229) == [(71,87187),(113,138763),(191,234547)]
  • (conjeturaRassia x) se verifica si para todos los primos menores que x (y mayores que 2) se cumple la conjetura de Rassia. Por ejemplo,
     conjeturaRassias (10^5)  ==  True

Soluciones

import Data.Numbers.Primes (primes, isPrime)
 
paresRassias :: Integer -> [(Integer,Integer)]
paresRassias p =
  [(a,b) | a <- primes
         , let b = (p - 1) * a - 1
         , isPrime b]
 
conjeturaRassias :: Integer -> Bool
conjeturaRassias x =
  and [(not . null . paresRassias) p | p <- tail (takeWhile (<x) primes)]

Referencias

2016 es un número práctico

Un entero positivo n es un número práctico si todos los enteros positivos menores que él se pueden expresar como suma de distintos divisores de n. Por ejemplo, el 12 es un número práctico, ya que todos los enteros positivos menores que 12 se pueden expresar como suma de divisores de 12 (1, 2, 3, 4 y 6) sin usar ningún divisor más de una vez en cada suma:

    1 = 1
    2 = 2
    3 = 3
    4 = 4
    5 = 2 + 3
    6 = 6
    7 = 1 + 6
    8 = 2 + 6
    9 = 3 + 6
   10 = 4 + 6
   11 = 1 + 4 + 6

En cambio, 14 no es un número práctico ya que 6 no se puede escribir como suma, con sumandos distintos, de divisores de 14.

Definir la función

   esPractico :: Integer -> Bool

tal que (esPractico n) se verifica si n es un número práctico. Por ejemplo,

   esPractico 12                                      ==  True
   esPractico 14                                      ==  False
   esPractico 2016                                    ==  True
   esPractico 42535295865117307932921825928971026432  ==  True

Soluciones

import Data.List (genericLength, group, nub, sort, subsequences)
import Data.Numbers.Primes (primeFactors)
import Graphics.Gnuplot.Simple
 
-- 1ª definición
-- =============
 
esPractico1 :: Integer -> Bool
esPractico1 n =
    takeWhile (<n) (sumas (divisores n)) == [0..n-1]
 
-- (divisores n) es la lista de los divisores de n. Por ejemplo,
--    divisores 12  ==  [1,2,3,4,6]
--    divisores 14  ==  [1,2,7]
divisores :: Integer -> [Integer]
divisores n = [k | k <- [1..n-1], n `mod` k == 0]
 
-- (sumas xs) es la lista ordenada de números que se pueden obtener como
-- sumas de elementos de xs sin usar ningún elemento más de una vez en
-- cada suma. Por ejemplo,  
--    sumas [1,2,3]  ==  [0,1,2,3,4,5,6]
--    sumas [1,2,7]  ==  [0,1,2,3,7,8,9,10]
sumas :: [Integer] -> [Integer]
sumas xs = sort (nub (map sum (subsequences xs)))
 
-- 2ª definición
-- =============
 
esPractico2 :: Integer -> Bool
esPractico2 n = all (esSumable (divisores n)) [1..n-1]
 
-- (esSumable xs n) se verifica si n se puede escribir como una suma de
-- elementos distintos de la lista creciente xs. Por ejemplo,
--    esSumable [1,2,7] 8  ==  True
--    esSumable [1,2,7] 6  ==  False
--    esSumable [1,2,7] 4  ==  False
--    esSumable [1,2,7] 2  ==  True
--    esSumable [1,2,7] 0  ==  True
esSumable :: [Integer] -> Integer -> Bool
esSumable _ 0  = True
esSumable [] _ = False
esSumable (x:xs) n = x <= n && (esSumable xs (n-x) || esSumable xs n)
 
-- 3ª definición
-- =============
 
-- Usando la caracterización de Stewart y Sierpiński: un entero n >= 2
-- es práctico syss para su factorización prima
--    n = p(1)^e(1) * p(2)*e(2) *...* p(k)^e(k)
-- se cumple que p(1) = 2 y, para cada i de 2 a k se cumple que
--                         1+e(j) 
--                i-1  p(j)       - 1
--    p(i) <= 1 +  ∏  ----------------
--                j=1     p(j) - 1
 
esPractico3 :: Integer -> Bool
esPractico3 1 = True
esPractico3 n = 
    x == 2 &&
    and [p <= 1 + c | (p,c) <- zip bases cotas]
    where xss       = factorizacion n
          (x:bases) = map fst xss
          cotas     = scanl1 (*) [(p^(1+e)-1) `div` (p-1) | (p,e) <- xss]
 
-- (factorizacion n) es la factorización de n. Por ejemplo, 
--    factorizacion  600  ==  [(2,3),(3,1),(5,2)]
--    factorizacion 1400  ==  [(2,3),(5,2),(7,1)]
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion n =
    [(head xs,genericLength xs) | xs <- group (primeFactors n)]
 
-- Comparación de eficiencia
-- =========================
 
--    λ> length [n | n <- [1..400], esPractico1 n]
--    92
--    (40.21 secs, 8,378,539,464 bytes)
--    λ> length [n | n <- [1..400], esPractico2 n]
--    92
--    (8.29 secs, 1,109,669,760 bytes)
--    λ> length [n | n <- [1..400], esPractico3 n]
--    92
--    (0.02 secs, 0 bytes)

Referencias

Basado en el artículo de Gaussianos Feliz Navidad y Feliz Año (número práctico) 2016.

Otras referencias

Listas hermanadas

Una lista hermanada es una lista de números estrictamente positivos en la que cada elemento tiene algún factor primo en común con el siguiente, en caso de que exista, o alguno de los dos es un 1. Por ejemplo,

  • [2,6,3,9,1,5] es una lista hermanada pues 2 y 6 tienen un factor en común (2); 6 y 3 tienen un factor en común (3); 3 y 9 tienen un factor en común (3); de 9 y 1 uno es el número 1; y de 1 y 5 uno es el número 1.
  • [2,3,5] no es una lista hermanada pues 2 y 3 no tienen ningún factor primo en común.

Definir la función

   hermanada :: [Int] -> Bool

tal que (hermanada xs) se verifica si la lista xs es hermanada según la definición anterior. Por ejemplo,

   hermanada [2,6,3,9,1,5]   ==  True
   hermanada [2,3,5]         ==  False
   hermanada [2,4..1000000]  ==  True

Nota: Este ejercicio es parte del examen del grupo 3 del 2 de diciembre.

Soluciones

-- 1ª definición (por comprensión)
hermanada1 :: [Int] -> Bool
hermanada1 xs = and [hermanos p | p <- zip xs (tail xs)]
 
-- (hermanos (x,y)) se verifica si x e y son hermanos; es decir, alguno es
-- igual a 1 o tienen algún factor primo en común
hermanos :: (Int, Int) -> Bool
hermanos (x,y) = x == 1 || y == 1 || gcd x y /= 1
 
-- 2ª definición (con all)
hermanada2 :: [Int] -> Bool
hermanada2 xs = all hermanos (zip xs (tail xs))
 
-- 3ª definición (por recursión)
hermanada3 :: [Int] -> Bool
hermanada3 (x1:x:xs) = hermanos (x1,x) && hermanada3 (x:xs)
hermanada3 _          = True
 
-- 4ª definición (por plegado)
hermanada4 :: [Int] -> Bool
hermanada4 xs =
    foldl (\ws p -> hermanos p && ws) True (zip xs (tail xs))
 
-- Comparación de eficiencia
--    λ> hermanada1 [2,4..1000000]
--    True
--    (2.33 secs, 476,586,552 bytes)
--    λ> hermanada2 [2,4..1000000]
--    True
--    (1.80 secs, 422,879,072 bytes)
--    λ> hermanada3 [2,4..1000000]
--    True
--    (2.58 secs, 477,251,896 bytes)
--    λ> hermanada4 [2,4..1000000]
--    True
--    (2.36 secs, 440,047,520 bytes)

Listas de igual longitud

Definir la función

   mismaLongitud :: [[a]] -> Bool

tal que (mismaLongitud xss) se verifica si todas las listas de la lista de listas xss tienen la misma longitud. Por ejemplo,

   mismaLongitud [[1,2],[6,4],[0,0],[7,4]] == True
   mismaLongitud [[1,2],[6,4,5],[0,0]]     == False

Soluciones

import Data.List (nub)    
 
-- 1ª solución:
mismaLongitud1 :: [[a]] -> Bool
mismaLongitud1 []       = True
mismaLongitud1 (xs:xss) = and [length ys == n | ys <- xss]
    where n = length xs
 
-- 2ª solución:
mismaLongitud2 :: [[a]] -> Bool
mismaLongitud2 xss = 
    and [length xs == length ys | (xs,ys) <- zip xss (tail xss)]
 
-- 3ª solución:
mismaLongitud3 :: [[a]] -> Bool
mismaLongitud3 (xs:ys:xss) = 
    length xs == length ys && mismaLongitud3 (ys:xss)
mismaLongitud3 _ = True           
 
-- 4ª solución
mismaLongitud4 :: [[a]] -> Bool
mismaLongitud4 [] = True
mismaLongitud4 (xs:xss) =
    all (\ys -> length ys == n) xss
    where n = length xs 
 
-- 5ª solución
mismaLongitud5 :: [[a]] -> Bool
mismaLongitud5 xss = length (nub [length xs | xs <- xss]) == 1
 
-- 6ª solución
mismaLongitud6 :: [[a]] -> Bool
mismaLongitud6 = null . drop 1 . nub . map length
 
-- Comparación de eficiencia
--    λ> mismaLongitud1 (replicate 20000 (replicate 20000 5))
--    True
--    (5.05 secs, 0 bytes)
--    λ> mismaLongitud2 (replicate 20000 (replicate 20000 5))
--    True
--    (9.98 secs, 0 bytes)
--    λ> mismaLongitud3 (replicate 20000 (replicate 20000 5))
--    True
--    (10.17 secs, 0 bytes)
--    λ> mismaLongitud4 (replicate 20000 (replicate 20000 5))
--    True
--    (5.18 secs, 0 bytes)
--    λ> mismaLongitud5 (replicate 20000 (replicate 20000 5))
--    True
--    (4.30 secs, 0 bytes)
--    λ> mismaLongitud6 (replicate 20000 (replicate 20000 5))
--    True
--    (4.19 secs, 0 bytes)

Máximos locales de una matriz

Un elemento de una matriz es un máximo local si es mayor que todos sus vecinos. Por ejemplo, en la matriz

    [[1,0,0,8],
     [0,2,0,3],
     [0,0,0,5],
     [3,5,7,6],
     [1,2,3,4]]

los máximos locales son 8 (en la posición (1,4)), 2 (en la posición (2,2)) y 7 (en la posición (4,3)).

Definimos el tipo de las matrices, mediante

   type Matriz a = Array (Int,Int) Int

y el ejemplo anterior por

   ej1 :: Matriz Int
   ej1 = listArray ((1,1),(5,4)) (concat [[1,0,0,8],
                                          [0,2,0,3],
                                          [0,0,0,5],
                                          [3,5,7,6],
                                          [1,2,3,4]])

Definir la función

   maximosLocales :: Matriz Int -> [((Int,Int),Int)]

tal que (maximosLocales p) es la lista de las posiciones en las que hay un máximo local, con el valor correspondiente. Por ejemplo,

   maximosLocales ej1 == [((1,4),8),((2,2),2),((4,3),7)]

Soluciones

import Data.Array
 
type Matriz a = Array (Int,Int) a
 
ej1 :: Matriz Int
ej1 = listArray ((1,1),(5,4)) (concat [[1,0,0,8],
                                       [0,2,0,3],
                                       [0,0,0,5],
                                       [3,5,7,6],
                                       [1,2,3,4]])
 
maximosLocales :: Matriz Int -> [((Int,Int),Int)]
maximosLocales p = 
    [((i,j),p!(i,j)) | (i,j) <- indices p,
               and [p!(a,b) < p!(i,j) | (a,b) <- vecinos (i,j)]] 
    where (_,(m,n)) = bounds p
          vecinos (i,j) = [(a,b) | a <- [max 1 (i-1)..min m (i+1)],
                                   b <- [max 1 (j-1)..min n (j+1)],
                                   (a,b) /= (i,j)]

Cuantificadores sobre listas

Enunciado

-- Definir la función 
--    verificaP :: (a -> Bool) -> [[a]] -> Bool
-- tal que (verificaP p xs) se verifica si cada elemento de la lista xss
-- contiene algún elemento que cumple el predicado p. Por ejemplo,
--    verificaP odd [[1,3,4,2], [4,5], [9]] == True
--    verificaP odd [[1,3,4,2], [4,8], [9]] == False

Soluciones

-- 1ª definición (por comprensión):
verificaP :: (a -> Bool) -> [[a]] -> Bool
verificaP p xss = and [any p xs | xs <- xss]
 
-- 2ª definición (por recursión):
verificaP2 :: (a -> Bool) -> [[a]] -> Bool
verificaP2 p []       = True
verificaP2 p (xs:xss) = any p xs && verificaP2 p xss
 
-- 3ª definición (por plegado):
verificaP3 :: (a -> Bool) -> [[a]] -> Bool
verificaP3 p = foldr ((&&) . any p) True
 
-- 4ª definición (con cuantificadores)
verificaP4 :: (a -> Bool) -> [[a]] -> Bool
verificaP4 p = all (any p)
 
-- 5ª definición (con cuantificadores y composición)
verificaP5 :: (a -> Bool) -> [[a]] -> Bool
verificaP5 = all . any

Mayores elementos de una matriz

Enunciado

-- Las matrices se pueden representar mediante listas de listas. Por
-- ejemplo, la matriz
--    |3 2 5|
--    |4 9 7|
-- se puede representar por [[3,2,5],[4,9,7]].
-- 
-- Definir la función
--    mayores :: Ord a => Int -> [[a]] -> [(a,Int)]
-- tal que (mayores n xss) es la lista de los n mayores elementos de la
-- matriz xss junto con sus correspondientes número de fila. Por
-- ejemplo,
--    ghci> mayores 4 [[4,26,9],[2,37,53],[41,1,8]]
--    [(53,2),(41,3),(37,2),(26,1)]
-- 
-- Comprobar con QuickCheck que todos los elementos de (mayores n xss)
-- son mayores o iguales que los restantes elementos de xss.
-- 
-- Nota: Se pueden usar las funciones sort y (\\) de la librería
-- Data.List.

Soluciones

import Data.List (sort, (\\))
import Test.QuickCheck
 
-- 1ª solución (con auxiliares)
-- ============================
 
mayores1 :: Ord a => Int -> [[a]] -> [(a,Int)]
mayores1 n xss = take n (reverse (sort (enumeracion xss)))
 
-- (enumeracion xss) es la lista de los elementos de xs junto con el
-- número de su fila. Por ejemplo,
--    ghci> enumeracion [[4,26,9],[2,37,53],[41,1,8]]
--    [(4,1),(26,1),(9,1),(2,2),(37,2),(53,2),(41,3),(1,3),(8,3)]
enumeracion :: [[a]] -> [(a,Int)]
enumeracion xss =
    [(x,i) | (xs,i) <- enumeracionFilas xss, x <- xs]
 
-- (enumeracionFilas xss) es la lista de las filas de xs junto con su
-- número. Por ejemplo,
--    ghci> enumeracionFilas [[4,26,9],[2,37,53],[41,1,8]]
--    [([4,26,9],1),([2,37,53],2),([41,1,8],3)]
enumeracionFilas :: [[a]] -> [([a],Int)]
enumeracionFilas xss = zip xss [1..]
 
-- 2ª solución (sin auxiliares)
-- ============================
 
mayores2 :: Ord a => Int -> [[a]] -> [(a,Int)]
mayores2 n xss = 
    take n (reverse (sort [(x,i) | (xs,i) <- zip xss [1..], x <- xs]))
 
-- Comprobaciones
-- ==============
 
-- Las dos definiciones son equivalentes
prop_equivalencia :: Int -> [[Int]] -> Bool
prop_equivalencia n xss =
    mayores1 n xss == mayores2 n xss
 
-- La comprobación es
--    ghci> quickCheck prop_equivalencia
--    +++ OK, passed 100 tests.
 
-- La propiedad de mayores es
prop_mayores :: Int -> [[Int]] -> Bool
prop_mayores n xss =
    and [x <= y | x <- elementos \\ elementosMayores, y <- elementosMayores]
    where elementos = concat xss
          elementosMayores = [x | (x,_) <- mayores1 n xss]
 
-- La comprobación es
--    ghci> quickCheck prop_mayores
--    +++ OK, passed 100 tests.
 
-- Otra forma de expresa la propiedad es
prop_mayores2 :: Int -> [[Int]] -> Bool
prop_mayores2 n xss = 
    all (\x -> all (<=x) elementosRestantes) elementosMayores
    where elementosMayores   = map fst (mayores1 n xss)
          elementosRestantes = concat xss \\ elementosMayores
 
-- La comprobación es
--    ghci> quickCheck prop_mayores2
--    +++ OK, passed 100 tests.

Suma de todos los anteriores.

Enunciado

-- Definir la función
--    sumaAnteriores :: [Integer] -> Bool
-- tal que (sumaAnteriores xs) se verifica si cada elemento de la lista
-- xs (excepto el primero) es la suma de sus anteriores elementos en la
-- lista. Por ejemplo,  
--    sumaAnteriores [3,3,6,12]  ==  True
--    sumaAnteriores [3,3,7,10]  ==  False
--    sumaAnteriores [3]         ==  True
--    sumaAnteriores []          ==  True

Soluciones

import Test.QuickCheck
 
-- 1ª definición (por recursión):
sumaAnteriores :: [Integer] -> Bool
sumaAnteriores xs = aux (reverse xs)
    where aux []     = True
          aux [_]    = True
          aux (x:xs) = x == sum xs && aux xs
 
-- 2ª definición (por comprensión):
sumaAnteriores2 :: [Integer] -> Bool
sumaAnteriores2 (x:y:zs) = 
    x == y && and [b == 2*a | (a,b) <- adyacentes (y:zs)]
    where adyacentes xs = zip xs (tail xs)
sumaAnteriores2 _ = True
 
-- La propiedad de equivalencia es
prop_equiv_sumaAnteriores :: [Integer] -> Bool
prop_equiv_sumaAnteriores xs = 
    sumaAnteriores xs == sumaAnteriores2 xs

Listas equidigitales

Enunciado

-- Una lista de números naturales es equidigital si todos sus elementos
-- tienen el mismo número de dígitos.
-- 
-- Definir la función
--    equidigital :: [Int] -> Bool
-- tal que (equidigital xs) se verifica si xs es una lista equidigital. 
-- Por ejemplo,
--    equidigital [343,225,777,943]   ==  True
--    equidigital [343,225,777,94,3]  ==  False

Soluciones

-- 1ª definición (por comprensión)
equidigital :: [Int] -> Bool
equidigital []     = True
equidigital (x:xs) = and [nCifras y == n | y <- xs]
    where n = nCifras x
 
-- (nCifras x) es el número de cifras de x. Por ejemplo,
--    nCifras 475  ==  3
nCifras :: Int -> Int
nCifras x = length (show x)
 
-- 2ª definición (por recursión)
equidigital2 :: [Int] -> Bool
equidigital2 (x:y:zs) = nCifras x == nCifras y && equidigital (y:zs)
equidigital2 _        = True