Menu Close

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

8 soluciones de “2016 es un número práctico

  1. josejuan
    -- Legible pero cuadrático en `check`
    factoriza :: ℤ → [(ℤ, Int)]
    factoriza n = [(p, length ps) | ps@(p:_) ← group $ primeFactors n]
     
    esPractico :: ℤ → Bool
    esPractico = check ∘ reverse ∘ factoriza
      where check [          ] = True
            check [(p, _)    ] = p ≡ 2
            check ((p, _): ps) = check ps ∧ p ≤ 1 +(combs ↥ ps)
                                 where combs (p, z) = (p^(z + 1) - 1) ÷ (p - 1)
     
     
     
    -- Críptico pero lineal en `check` (más eficiente, ej. `esPractico $ product [1..1000]`)
    esPractico' :: ℤ → Bool
    esPractico' = isJust ∘ check ∘ reverse ∘ preF
      where preF n = [(p, (p^(length ps + 1) - 1) ÷ (p - 1)) | ps@(p:_) ← group $ primeFactors n]
            check [          ] = η 1
            check [(p, c)    ] = guard (p ≡ 2) » η c
            check ((p, c): ps) = check ps ↪ λcc → guard (p ≤ 1 + cc) » η (c × cc)
  2. Chema Cortés
    import Data.Numbers.Primes (primeFactors)
    import Data.List (group)
     
    -- Aplicando la demostración de Stewart y Sierpiński
    -- https://en.wikipedia.org/wiki/Practical_number#Characterization_of_practical_numbers
    esPractico :: Integer -> Bool
    esPractico n = and $ zipWith (<=) (tail factores) productos
        where pss = group (primeFactors n)
              factores = [head ys - 1 | ys <- pss]
              productos = scanl1 (*) $ map product pss
    • josejuan

      No parece correcto (ej. el 1 sí es práctico, el 7 no, …) ¿no deberías considerar las potencias? (yo también he aplicado la misma relación). PD: los primeros prácticos son: 1, 2, 4, 6, 8, 12, 16, 18, 20, 24, 28, 30, 32, 36, 40, 42, 48, 54, 56, 60, 64, 66, 72, 78, 80, …

      • Chema Cortés

        Muchas gracias por la corrección. Había leído demasiado rápido la propuesta de Stewart y Sierpiński. Aquí va la corrección:

        import Data.Numbers.Primes (primeFactors)
        import Data.List (group)
         
        -- Aplicando la demostración de Stewart y Sierpiński
        -- https://en.wikipedia.org/wiki/Practical_number#Characterization_of_practical_numbers
        esPractico :: Integer -> Bool
        esPractico 1 = True
        esPractico n = (head factores == 2) &&
                       and (zipWith (<=) (tail factores) sumaDivisores)
            where pss = group (primeFactors n)
                  factores = [head ys | ys <- pss]
                  sumaDivisores = tail $ scanl (acc xs -> acc + sum xs) 1 pss
  3. Abel Martín

    Traducción directa (aunque ineficiente).

    import Data.List (sort, nub, subsequences)
     
    esPractico :: Integer -> Bool
    esPractico 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)))
  4. Chema Cortés
    -- Aplicando la propuesta de Stewart y Sierpiński
    -- https://en.wikipedia.org/wiki/Practical_number#Characterization_of_practical_numbers
    esPractico :: Integer -> Bool
    esPractico 1 = True
    esPractico n = even n && and (zipWith (<=) (tail factores) sumaDivisores)
        where pss = group (primeFactors n)
              factores = [head ys | ys <- pss]
              -- suma progresión geométrica Sn = r^0 + r^1 + ... + r^n
              sumag xs = let r = head xs in (r * product xs - 1) `div` (r - 1)
              sumaDivisores = map (+1) $ scanl1 (*) (map sumag pss)

Escribe tu solución

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