Menu Close

Números superabundantes

El enunciado de un problema para la IMO (Olimpiada Internacional de Matemáticas) de 1983 es

Sea n un número entero positivo. Sea σ(n) la suma de los divisores positivos de n (incluyendo al 1 y al n). Se dice que un entero m ≥ 1 es superabundante (P. Erdös, 1944) si ∀k ∈ {1, 2, …, m-1}, σ(m)/m > σ(k)/k. Demostrar que existen infinitos números superabundantes.

Definir la lista

   superabundantes :: [Integer]

cuyos elementos son los números superabundantes. Por ejemplo,

   take 7 superabundantes == [1,2,4,6,12,24,36]
   superabundantes !! 25  ==  166320
Soluciones
import Data.Numbers.Primes (primeFactors)
import Data.List (genericLength, group)
import Data.Ratio ((%))
 
-- 1ª solución
-- ===========
 
superabundantes :: [Integer]
superabundantes =
  filter esSuperabundante [1..]
 
-- (esSuperabundante n) se verifica si n es superabundante. Por ejemplo,
--    esSuperabundante 4  ==  True
--    esSuperabundante 5  ==  False
--    esSuperabundante 6  ==  True
esSuperabundante :: Integer -> Bool
esSuperabundante n =
  and [k * n' > n * sumaDivisores k | k <- [1..n-1]]
  where n' = sumaDivisores n
 
-- (sumaDivisores n) es la suma de los divisores de n. Por ejemplo.
--      sumaDivisores 35  ==  48
sumaDivisores :: Integer -> Integer
sumaDivisores x =
  product [(p^(e+1)-1) `div` (p-1) | (p,e) <- factorizacion x]
 
-- (factorizacion x) es la lista de las bases y exponentes de la
-- descomposición prima de x. Por ejemplo,
--    factorizacion 600  ==  [(2,3),(3,1),(5,2)]
factorizacion :: Integer -> [(Integer,Integer)]
factorizacion = map primeroYlongitud . group . primeFactors
 
-- (primeroYlongitud xs) es el par formado por el primer elemento de xs
-- y la longitud de xs. Por ejemplo,
--    primeroYlongitud [3,2,5,7] == (3,4)
primeroYlongitud :: [a] -> (a,Integer)
primeroYlongitud (x:xs) = (x, 1 + genericLength xs)
primeroYlongitud _      = error "No tiene elementos"
 
-- 2ª solución
-- ===========
 
superabundantes2 :: [Integer]
superabundantes2 =
  [n | (n,a,b) <- zip3 [1..] cocientes maximosCocientes,
        a == b]
-- cocientes es la lista de los cocientes σ(k)/k. Por ejemplo,
--    λ> take 7 cocientes
--    [1 % 1,3 % 2,4 % 3,7 % 4,6 % 5,2 % 1,8 % 7]
cocientes :: [Rational]
cocientes =
  [sumaDivisores n % n | n <- [1..]]
 
-- maximosCocientes es la lista de los máximos de los cocientes
-- σ(k)/k. Por ejemplo,
--    λ> take 7 maximosCocientes
--    [1 % 1,3 % 2,3 % 2,7 % 4,7 % 4,2 % 1,2 % 1]
maximosCocientes :: [Rational]
maximosCocientes = scanl1 max cocientes
 
-- Comparación de eficiencia
-- =========================
 
-- La comparación es
--    λ> superabundantes !! 22
--    27720
--    (6.72 secs, 11,453,705,704 bytes)
--    λ> superabundantes2 !! 22
--    27720
--    (0.54 secs, 902,054,096 bytes)

En los comentarios se pueden escribir otras soluciones, escribiendo el código entre una línea con <pre lang="haskell"> y otra con </pre>

2 soluciones de “Números superabundantes

  1. Joaquín Infante Rodríguez
    import Data.List
     
    sumaDivisores :: Integer -> Integer
    sumaDivisores n = sum [x | x<-[1..n], rem n x == 0]
     
    esSuperabundante :: Integer -> Bool
    esSuperabundante m = and [((func1 m)/(func2 m)) > ((func1 k)/(func2 k))|  k<-[1..m-1]]
                         where func1 n = fromIntegral (sumaDivisores n)
                               func2 n = fromIntegral n
     
    superabundantes :: [Integer]
    superabundantes = 1:[x | x<-[2,4..], esSuperabundante x]
  2. Alejandro García Alcaide
    import Data.Numbers.Primes
    import Test.QuickCheck
    import Data.List
     
    -- Hacemos uso de un par de funciones auxiliares que nos ayuden a definir la
    -- lista superabundantes: 
    -- divisores n es la lista de los divisores de n (incluyendo al 1 y n)
     
    divisores :: Integer -> [Integer]
    divisores n = [x | x <- [1..n], mod n x == 0]
     
    -- esSuperAbundante comprueba si un numero n es superabundante
     -- esSuperAbundante 4 == True
     -- esSuperAbundante 2 == True
     
    esSuperAbundante :: Integer -> Bool
    esSuperAbundante n =
      genericLength ([x | x <- [1..n-1], r*x >  n*(sigma x)]) == n-1
      where r       = sum (divisores n)
            sigma t = sum(divisores t)
     
    -- Con esto, llegamos a la definicion de la lista buscada:
    superabundantes :: [Integer]
    superabundantes = filter esSuperAbundante [1..]
     
    -- Sin embargo, no es eficiente pues:
    -- superabundantes !! 14
    -- 840
    -- (12.72 secs, 3,121,773,056 bytes)
     
    -- Planteamos una hipotesis. Comprobemos que si n es primo mayor que 2,
    -- entonces n no será superabundante:
    propiedad1 :: Integer -> Property
    propiedad1 n = isPrime n && n>2 ==> not (esSuperAbundante n)
     
     
    -- quickCheck propiedad1
    -- +++ OK, passed 100 tests.
    -- (0.09 secs, 19,629,488 bytes)
     
    -- Veamos si n es impar mayor que 1 entonces n no será tampoco superabundante:
    propiedad2 :: Integer -> Property
    propiedad2 n = odd n && n>1 ==> not (esSuperAbundante n)
     
    -- quickCheck propiedad2
    -- +++ OK, passed 100 tests.
    -- (0.05 secs, 10,226,624 bytes)
     
     
    -- Definamos una funcion auxiliar basada en esSuperAbundante:
    esSuperAbundante' :: Integer -> Bool
    esSuperAbundante' n = not (isPrime n) && esSuperAbundante n
     
    -- Entonces:
    superabundantes1 :: [Integer]
    superabundantes1 = 1:2:4:6: filter esSuperAbundante' [12*n | n <- [1..]]
     
    -- Viendo la construccion de la lista:
    -- take 13 superabundantes == [1,2,4,6,12,24,36,48,60,120,180,240,360]
    -- Podemos plantearnos si para n>12, cualquier numero superabundante sea
    -- multiplo de 12.
    propiedad3 :: Integer -> Property
    propiedad3 n = n>=12 && esSuperAbundante' n ==> mod n 12 == 0

Leave a Reply

Este sitio usa Akismet para reducir el spam. Aprende cómo se procesan los datos de tus comentarios.