2016 es un número práctico

José A. Alonso, 4-enero-2016

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)

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

M. Margenstern (1991), Les nombres pratiques: théorie, observations et conjectures.
G. Melfi, Practical numbers.
G. Melfi (2008), A survey on practical numbers.
OEIS, Sucesión A005153.
PlanetMath.org, Practical number.
E.W. Weisstein, Practical number.
A. Weingartner (2015), Practical numbers and the distribution of divisors.
Wikipedia, Practical number.

Posted in Medio

Tagged all, and, Comprensión, div, fst, genericLength, group, head, map, mod, nub, Orden superior, primeFactors, Recursión, scanl1, sort, subsequences, sum, takeWhile, zip

8 Comments

josejuan

4-enero-2016 at 10:26

Responder

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

Chema Cortés

4-enero-2016 at 13:37

Responder

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

4-enero-2016 at 13:58

Responder

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

7-enero-2016 at 16:01

Responder

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

Abel Martín
7-enero-2016 at 18:15
Responder

Falla para algunos números: 28, 42, 66, 78,…
- Chema Cortés
  8-enero-2016 at 09:55
  
  Tienes toda la razón. Añado en un nuevo mensaje una nueva revisión.

Abel Martín

7-enero-2016 at 18:21

Responder

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

Chema Cortés

8-enero-2016 at 09:59

Responder

-- 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ónCancel reply

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

Subscribe to Blog via Email

Entradas recientes

Etiquetas

2016 es un número práctico

Soluciones

Referencias

Se puede imprimir o compartir con

8 Comments

Escribe tu soluciónCancel reply

Subscribe to Blog via Email

Entradas recientes

Etiquetas